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FOREWORD 


This  As-built  Product  Specification,  divided  into  four  volumes,  covers 
work  performed  under  Air  Force  Contract  F33615-85-C-5122,  Geometric  Modeling 
Applications  Interface  Program  (GMAP),  covering  the  period  1  August  1985  to 
31  March  1989.  The  document  addresses  the  GMAP/PDDI  System  Components 
developed  or  enhanced  under  this  contract  which  is  sponsored  by  the  Computer 
Integrated  Manufacturing  Branch,  Materials  Laboratory,  Air  Force  Systems 
Command,  Wright  Air  Force  Base,  Ohio  45433-6533.  The  GMAP  Project  Manager 
for  the  Air  Force  is  Mr.  Charles  Gilman. 

The  primary  contractor  is  Pratt  &  Whitney,  an  operating  unit  of  United 
Technologies  Corporation.  Mr.  Richard  Lopatka  is  managing  the  GMAP  project 
at  Pratt  &  Whitney.  Ms.  Linda  Phillips  is  the  Program  Integrator.  Mr.  John 
Hamill  is  the  Deputy  Program  Manager. 

McDonnell  Aircraft  Company  was  the  subcontractor  responsible  for  the  PDDI 
System  Component  work.  Mr.  Jerry  Weiss  is  the  GMAP  Program  Manager  at 
McDonnell  Aircraft  and  Mr.  Herb  Ryan  is  the  Deputy  Program  Manager. 

Volume  II  of  this  documnet  provides  the  Schema  Manager  routine  listings. 


NOTE:  The  number  and  date  in  the  upper  right  corner  of  each  page  in  this 
document  indicate  that  it  has  been  prepared  in  accordance  to  the 
ICAM  CM  Life  Cycle  Documentation  requirements  for  a  Configuration 
Item  (Cl). 
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3.10  Routine  Listings 


3.10.1  Schema  Manager 

This  Section  presents  the  software  routines  that  comprise  the  GMAP/PDDI 
system.  The  routine  for  each  primary  system  component,  listed  below,  are 
presented  in  alphabetical  order: 


o  3.10.1  —  Schema  Manager  (Volume  II) 
o  3.10.2  —  MAS  (Volume  III) 
o  3.10.3  —  N/VI  (Volume  III) 
o  3.10.4  —  System  Translator  (Volume  IV). 


3.10.1.1  Index 


ADDENUM 

ADDFIELD 

APPROVE 

BATDVR 

BATERR 

BATRPT 

BCSMAIN 

BLDARRAY 

BLDBPDEF 

BLDCLASS 

BLDCLS 

BLDDFTYP 

BLDEITEM 

BLDENT 

BLDENUMR 

BLDFIELD 

BLDGBLFD 

BLDINT 

BLDLOG 

BLDPNTR 

BLDREAL 

BLDSSCMA 

BLDSTRNG 

BLDSTRUG 

BLDSUB 

BLDSUPER 

BLDUNRES 

BLEXICAL 

BSCINCLD 


-  Displays  the  ADD  ENUMERATION  menu. 

-  Displays  the  ADDFIELD  menu. 

-  Displays  the  APPROVE  UPDATE  menu. 

-  Mainline  driver  for  the  Batch  Interface. 

-  Error  reporting  and  recovery  for  the  Batch  Interface. 

-  Batch  Int-jrface  routine  to  invoke  report  generation  routines 

-  Main  driver  for  the  Conceptual  Schema  Report. 

-  Builds  the  ARRAY  definition. 

-  Builds  the  BACKPATCH  list  for  unresolved  references. 

-  Builds  the  CLASS  definition. 

-  Batch  Interface  routine  that  creates  a  CLASS  definition. 

-  Builds  the  DEFINED  TYPE  definition. 

-  Builds  the  ENUMERITEM  definition. 

-  Builds  the  ENTITY  definition. 

-  Builds  the  ENUMERATION  definition. 

-  Builds  the  ATTRIBUTE  definition. 

-  Builds  the  GLOBAL  ATTRIBUTE  definition. 

-  Builds  the  INTEGER  definition. 

-  Builds  the  LOGICAL  definition. 

-  Builds  the  POINTER  definition. 

-  Builds  the  REAL  definition. 

-  Builds  the  SUBSCHEMA  definition. 

-  Builds  the  STRING  definition. 

-  Builds  the  STRUCTURE  definition. 

-  Creates  a  SUBSCHEMA  definition. 

-  Create  a  SUPERTYPE  definition. 

-  Stores  unresolved  references. 

-  Obtains  the  longest  lexeme,  excluding  comments. 

-  Generates  the  PASCAL  Include  File. 
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BSCTRSPR 

CLRSTK 

CRARRAY 

CRCLASS1 

CRCLASS2 

CRDEFTYP 

CRENTITY 

CRENUM 

CRFIELD 

CRINTGR 

CRLIST 

CRPNTR 

CRREAL 

CRSET 

CRSTRING 

CRSUBSCM 

CRSUPTYP 

CRURUL 

GSARYWRT 

CSCLSHDG 

CSGLSWRT 

CSDEFHDG 

CSDEFWRT 

CSENMWRT 

CSENTHDG 

CSENTWRT 

CSGBLHDG 

CSGBLWRT 

CSHDGWRT 

CSINDWRT 

CSINTWRT 

CSLOGWRT 

CSMAIN 

CSNEWPG 

CSPTRWRT 

CSRELWRT 

CSRMAIN 

CSRMENU 

CSRPTCVR 

CSSTGWRT 

CSSTRWRT 

CSSUBHDG 

CSSUBWRT 

CSSUPHDG 

CSSUPWRT 

CSTYPWRT 

DDABNDS 


-  Process  the  entries  on  the  transaction  stack. 

-  Clears  the  transaction  stack. 

-  Displays  the  CREATE  ARRAY  menu. 

-  Displays  the  first  CREATE  CLASS  menu. 

-  Displays  the  second  CREATE  CLASS  menu. 

-  Displays  the  CREATE  DEFINED  TYPE  menu. 

-  Displays  the  CREATE  ENTITY  menu. 

-  Displays  the  CREATE  ENUMERATION  menu. 

-  Displays  the  CREATE  ATTRIBUTE  menu. 

-  Displays  the  CREATE  INTEGER  menu. 

-  Display  the  CREATE  LIST  menu. 

-  Displays  the  CREATE  POINTER  menu. 

-  Displays  the  CREATE  REAL  menu. 

-  Displays  the  CREATE  SET  menu. 

-  Displays  the  CREATE  STRING  menu. 

-  Displays  the  CREATE  SUBSCHEMA  menu. 

-  Displays  the  CREATE/REFERENCE  SUPERTYPE  menu. 

-  Creates  user  delete  rules  for  MAS. 

-  Writes  out  an  ARRAY  definition. 

-  Writes  out  a  CLASS  heading  on  a  new  page. 

-  Writes  out  CLASS  definitions  to  a  file. 

-  Writes  out  a  DEFINED  TYPE  heading  on  a  new  page. 

-  Writes  out  a  DEFINED  TYPE  name. 

-  Writes  out  an  ENUMERATION  definition. 

-  Writes  out  an  ENTITY  heading  on  a  new  page. 

-  Writes  out  ENTITY  definitions  to  a  file. 

-  Writes  out  a  GLOBAL  ATTRIBUTE  heading  on  a  new  page. 

-  Writes  out  GLOBAL  ATTRIBUTE  definitions  to  a  file. 

-  Calls  the  appropriate  heading  routine. 

-  Writes  an  index  for  ENTITIES,  CLASSES,  or  SUBSCHEMAS. 

-  Writes  out  an  INTEGER  definition. 

-  Writes  out  a  LOGICAL  definition. 

-  Main  driver  for  the  Conceptual  Schema  Report. 

-  Creates  a  new  page  in  the  Conceptual  Schema  Report. 

-  Writes  out  a  POINTER  definition. 

-  Writes  out  a  REAL  definition. 

-  Generate,  browse  or  print  the  Conceptual  Schema  Report. 

-  Display  the  Conceptual  Schema  Report  menu. 

-  Prints  out  the  cover  page  for  the  Conceptual  Schema  Report. 

-  Writes  out  a  STRING  definition. 

-  Writes  out  a  STRUCTURE  definition. 

-  Writes  out  a  SUBSCHEMA  heading  on  a  new  page. 

-  Writes  out  SUBSCHEMA  definitions  to  a  file. 

-  Write  a  SUPERTYPE  heading  on  a  new  page. 

-  Write  out  SUPERTYPE  definitions. 

-  Writes  out  DEFINED  TYPE  definitions  to  a  file. 

-  Writes  out  the  low  bound  and  high  bound  for  a  ARRAY  attribute. 


DDADB 

DDARRAY 

DDCL 

DDCLASS 

DDENTITY 

DDENUM 

DDREPORT 

DDSTRUC 

DDWRITE 

DEFADD 

DEFARR 

DEFATT 

DEFBAS 

DEFCLS 

DEFDEF 

DEFENM 

DEFENT 

DEFGBL 

DEFPRE 

DEFPTR 

DEFQUERY 

DEFSTC 

DEFSUB 

DEFSUP 

DEFTYP 

DISPLIST 

ENTCLS 

ERRMSG 

ERRREC 

GETDD 

LEXICAL 

LMEM23 

MCREATE 

MFILMOD 

MINCLUD 

MMAIN 

MNEWMOD 

MQBHALL 

MQBHATT 

MQBHATTS 

MQBHENT 

MQBHMAIN 

MQCLMU 

MQGEXVAL 

MQGTDEFN 

MQIAATT 

MQIAENT 
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-  Writes  out  the  ADB  portion  of  an  entity. 

-  Writes  out  the  ARRAY  attribute  of  an  entity. 

-  Writes  out  the  CONSTITUENT  LIST  portion  of  an  entity. 

-  Writes  the  class  KINDS  to  a  file. 

-  Writes  the  entity  KINDS  to  a  file. 

-  Writes  out  the  ENUMERATION  attribute  of  an  entity. 

-  Writes  the  DATA  DICTIONARY  (character  form)  of  the  definitions. 

-  Writes  out  STRUCTURE  definitions. 

-  Writes  out  ENTITY  definitions. 

-  Add  a  forward  reference  to  a  list  of  unresolved  references. 

-  Process  an  ARRAY  definition. 

-  Process  an  ATTRIBUTE  definition. 

-  Process  a  primitive  data  type  definition. 

-  Process  a  CLASS  definition. 

-  Process  a  DEFINED  TYPE  reference. 

-  Process  an  ENUMERATION  definition. 

-  Process  an  ENTITY  definition. 

-  Process  a  GLOBAL  ATTRIBUTE  definition. 

-  Process  a  numeric  precision  or  string  length. 

-  Process  a  POINTER  definition. 

-  Determines  if  a  new  entity  satisfies  an  unresolved  reference. 

-  Process  a  STRUCTURE  definition. 

-  Process  a  SUBSCHEMA  definition. 

-  Process  a  SUPERTYPE  definition. 

-  Process  a  DEFINED  TYPE  definition. 

-  Displays  a  list  of  entities. 

-  Determines  if  a  name  has  been  used  for  an  entity  or  class. 

-  Formats  a  Batch  Interface  error  message. 

-  Recover  from  a  Batch  Interface  error. 

-  Reads  the  DATA  DICTIONARY  (character  form)  of  the  definitions. 

-  Obtains  the  longest  lexeme,  including  comments. 

-  Displays  the  LIST  MEMBERS  menu. 

-  Displays  the  CREATE  menu. 

-  Displays  the  FILE/RETRIEVE  menu. 

-  Displays  the  list  of  SUBSCHEMAS. 

-  Displays  the  MAIN  menu. 

-  Displays  the  menu  to  confirm  creation  of  a  new  model. 

-  Prints  all  entities  in  the  model. 

-  Prints  individual  instances  of  a  specified  entity  kind. 

-  Prints  all  instances  of  a  specified  entity  kind. 

-  Prompt  for  all  or  selected  instances  of  an  entity  kind. 

-  Prompt  for  all  or  selected  entity  kinds. 

-  Displays  a  list  of  constituents. 

-  Converts  an  attribute  value  to  character  form. 

-  Retrieves  the  entity  definition  from  the  Data  Dictionary. 

-  Displays  individual  instances  of  a  specified  entity  kind. 

-  Displays  interactive  entity  menu. 
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MQIAMAIN 

MQNCLMU 

MQNUSRMU 

MQUDVR 

MQUSRMU 

MREPORT 

MREVIEW 

MUPDATE 

NVRTVRS 

PHALFLD 

PHALST 

PHBNST 

PHBYFPOS 

PHDECBYT 

PHENTITY 

PHGLOBAL 

PHGTFLD 

PHGTST 

PHPOSITN 

PHSRTFLD 

PHSRTORD 

PHSUBTYP 

PHWOFPOS 

PHYSICAL 

PSGTSM 

PSMASKND 

PSORDER 

PSRABNDS 

PSRADB 

PSRARRAY 

PSRCL 

PSRENUM 

PS REPORT 

PSRHEAD 

PSRINDEX 

PSRNAME 

PSRSTC 

PSTRGF 

PSTRSM 


-  Displays  main  interactive  menu. 

-  Displays  a  menu  when  no  constituents  found. 

-  Displays  a  menu  when  no  users  found. 

-  Mainline  driver  for  the  Model  Query  Utility. 

-  Displays  the  list  of  users  for  a  specific  entity. 

-  Displays  the  menu  for  REPORT  selection. 

-  Displays  the  REVIEW  menu. 

-  Displays  the  UPDATE  menu. 

-  Retrieves  entity  definitions  from  the  file. 

-  Creates  physical  definition  for  an  ATTRIBUTE. 

-  Assign  physical  location  for  a  STRUCTURE  attribute. 

-  Group  attributes  by  boundary  alignment  requirements. 

-  Assign  physical  locations  for  attributes  with  a  position 
override  specified. 

-  Determine  byte  precision  from  decimal  precision  and  group  by 
boundary  alignment  requirements. 

-  Assign  physical  locations  to  the  attributes  of  an  entity. 

-  Assign  physical  locations  for  GLOBAL  ATTRIBUTES. 

-  Get  the  ATTRIBUTE  for  which  a  physical  definition  is  to  be 
created. 

-  Determines  the  physical  definition  of  a  STRUCTURE  based  on  its 
component  ATTRIBUTES. 

-  Determines  the  attribute  position  order. 

-  Determines  the  location  of  attributes  according  to  boundary 
alignment  requirements. 

-  Sort  attributes  by  position  override. 

-  Determines  the  physical  location  for  supertype  attributes. 

-  Determines  the  location  of  attributes  without  position  override. 

-  Main  driver  for  creating  physical  definitions. 

-  Build  the  run-time  subschema  for  the  Physical  Subschema  Report. 

-  Insert  the  attributes  required  by  MAS. 

-  Determine  physical  schema  order  of  attributes  within  entity. 

-  Writes  out  the  low  bound  and  high  bound  for  a  ARRAY  attribute. 

-  Writes  out  the  ADB  portion  of  an  entity. 

-  Writes  out  the  ARRAY  attribute  of  an  entity. 

-  Writes  out  the  CONSTITUENT  LIST  portion  of  an  entity. 

-  Writes  out  the  ENUMERATION  attribute  of  an  entity. 

-  Writes  the  PHYSICAL  SUBSCHEMA  REPORT, 

-  Writes  the  heading  for  the  PHYSICAL  SUBSCHEMA  REPORT. 

-  Writes  the  table  of  contents  for  the  PHYSICAL  SUBSCHEMA  REPORT. 

-  Identify  an  attribute  as  global,  inherited,  or  local. 

-  Write  a  STRUCTURE  attribute  to  the  Physical  Subschema  Report. 

-  Insert  the  GLOBAL  ATTRIBUTES  into  the  run-time  subschema  for  the 
Physical  Subschema  Report. 

-  Insert  an  entity  into  the  run-time  subschema  for  the  Physical 
Subschema  Report. 
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PSTRST 

PSTRSTC 

REARRAY 

RECLASS 

REDEFTYP 

REENTITY 

REENUM 

REFIELD 

RE FI ELD 1 

REFIELD2 

REFSUP 

REINTGR 

RELIST 

REPNTR 

REREAL 

RESET 

RESTRING 

RESTRUC 

RESUBSCM 

RESUPTYP 

RSCPAI 

RSCPAT 

RSCPCI 

RSCPCT 

RSCPEI 

RSCPET 

RSFILE 

RSGTSM 

RSMASKND 

RSORDER 

RSTRGF 

RSTRSM 

RSTRST 

RSTRSTC 


-  Insert  a  SUPERTYPE  into  the  run-time  subschema  for  the  Physical 
Subschema  Report. 

-  Insert  a  STRUCTURE  attribute  into  the  run-time  subschema  for  the 
Physical  Subschema  Report. 

-  Displays  the  REVIEW  ARRAY  menu. 

-  Displays  the  REVIEW  CLASS  menu. 

-  Displays  the  REVIEW  DEFINED  TYPE  menu. 

-  Displays  the  REVIEW  ENTITY  menu. 

-  Displays  the  REVIEW  ENUMERATION  menu. 

-  Displays  the  REVIEW  ATTRIBUTE  menu. 

-  Displays  the  REVIEW  ATTRIBUTE  menu. 

-  Displays  the  REVIEW  ATTRIBUTE  menu. 

-  Batch  interface  routine  to  resolve  a  reference  to  a  SUPERTYPE. 

-  Displays  the  REVIEW  INTEGER  menu. 

-  Displays  the  REVIEW  LIST  menu. 

-  Displays  the  REVIEW  POINTER  menu. 

-  Displays  the  REVIEW  REAL  menu. 

-  Displays  the  REVIEW  SET  menu. 

-  Displays  the  REVIEW  STRING  menu. 

-  Displays  the  REVIEW  STRUCTURE  menu. 

-  Displays  the  REVIEW  SUBSCHEMA  menu. 

-  Displays  the  REVIEW  SUPERTYPE  MENU. 

-  Copies  the  array  index  table  into  the  run-time  subschema  data 
structure. 

-  Copies  the  array  size  and  bounds  into  the  run-time  subschema 
data  structure. 

-  Copies  the  pointer  index  table  into  the  run-time  subschema  data 
structure. 

-  Copies  the  pointer  kinds  into  the  run-time  subschema  data 
structure. 

-  Copies  the  enumeration  index  table  into  the  run-time  subschema 
data  structure. 

-  Copies  the  enumeration  values  into  the  run-time  subschema  data 
structure. 

-  Writes  the  run-time  subschema  data  structure  to  a  file. 

-  Builds  the  run-tirae  data  structure  from  the  schema  model. 

-  Inserts  the  MAS  required  attributes  into  the  run-time  subschema 
data  structure. 

-  Determines  the  physical  schema  order  of  the  attributes. 

-  Enters  GLOBAL  ATTRIBUTES  into  the  run-tirae  subschema  data 
structure. 

-  Enters  the  ATTRIBUTES  for  an  entity  into  the  run-time  subschema 
data  structure. 

-  Inserts  a  SUPERTYPE  into  the  run-time  subschema  data  structure. 

-  Inserts  a  STRUCTURE  attribute  into  the  run-time  subschema  data 
structure. 


RS1100 

SCALFSRT 

SCARYCR 

SCARYUP 

SCBASIN 

SCCHRCK 

SCCLSCR1 

SCCLSCR2 

SCCLSUP 

SCCOMPAR 

SCCONIN 

SCCREATE 

SCDEFCR 

SCDEFUP 

SCENMUP 

SCENTCR 

SCENTIN 

SCENTUP 

SCENUCR 

SCEXIST 

SCFLDAD 

SGFLDCR 

SCFLDIN 

SCFLDLST 

SCFLDSRT 

SCFLDST 

SCFLDUP 

SCFNDKEY 

SCGENRPX 

SCHDVR 

SCINCLD 

SCINTCR 

SCINTUP 

SCKEFIND 

SCKEYIN 

SCLISTCR 

SCLISTUP 

SCMASIN 

SCMEMAD 

SCMEMLST 

SCPOPKE 

SGPOPTR 

SCPRMFL 
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-  Inserts  an  ARRAYJBNTITY  pseudo  entity  into  the  run-time 
subschema  data  structure. 

-  The  ordering  function  used  with  MALSRT. 

-  Creates  an  ARRAY  definition. 

-  Updates  an  ARRAY  definition. 

-  Writes  the  ENTITY  KIND  constants  for  the  PASCAL  Include  File. 

-  Validates  an  entity  name. 

-  Gathers  the  name  and  kind  for  a  CLASS  definition. 

-  Gathers  the  members  of  a  CLASS  definition. 

-  Updates  a  CLASS  definition. 

-  Compares  two  names  for  uniqueness. 

-  Writes  the  ENTITY  KIND  constants  for  the  PASCAL  Include  File. 

-  Determines  the  next  menu  for  the  selected  CREATE  option. 

-  Creates  a  DEFINED  TYPE  definition. 

-  Updates  a  DEFINED  TYPE  definition. 

-  Updates  an  ENUMERATION  definition. 

-  Creates  an  ENTITY  definition. 

-  Writes  the  ENTITY  definitions  for  the  PASCAL  Include  File. 

-  Updates  an  ENTITY  definition. 

-  Creates  an  ENUMERITEM  definition. 

-  Verifies  a  reference  to  an  ENTITY. 

-  Adds  an  ATTRIBUTE  to  an  entity. 

-  Creates  an  ATTRIBUTE  definition. 

-  Writes  an  ATTRIBUTE  definition  to  the  PASCAL  Include  File. 

-  Creates  a  list  of  attributes  for  an  entity,  supertype,  or 
structure. 

-  Locates  the  MAS  key  for  a  Schema  Model  element. 

-  Sorts  the  ATTRIBUTES  of  an  entity  into  physical  schema  order. 

-  Updates  an  ATTRIBUTE  definition. 

-  Locates  the  MAS  key  for  a  Schema  Model  element. 

-  Determines  the  SUBSCHEMA  for  a  report  and  call  the  generation 
routine. 

-  Mainline  driver  for  the  Schema  Manager  Interactive  Interface. 

-  Driver  to  generate  the  PASCAL  Include  File. 

-  Creates  an  INTEGER  definition. 

-  Updates  an  INTEGER  definition. 

-  Locates  the  MAS  key  for  a  definition  to  be  updated  or  reviewed. 

-  Writes  the  KEYBLOCK  declaration  for  the  PASCAL  Include  File. 

-  Creates  a  LIST  definition. 

-  Updates  a  LIST  definition. 

-  Writes  the  ENTBLOCK  declaration  for  ths  PASCAL  Include  File. 

-  Displays  a  list  of  members,  return  the  key  of  the  one  selected. 

-  Lists  the  members/constituents  of  an  entity,  class,  subschema, 
pointer,  structure,  global  attribute  or  enumeration. 

-  Pop  an  entry  from  the  stack  of  keys. 

-  Pop  an  entry  from  the  stack  of  transactions. 

-  Builds  an  array  of  entity  names. 
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SCPRMRE 

SCPTRCR 

SCPTRUP 

SCPUSHKE 

SCPUSHTR 

SCRELCR 

SCRELUP 

SCREVIEW 

SCRPTM 

SCSETCR 

SCSETUP 

SCSRTPOS 

SCSTCUP 

SCSTGCR 

SCSTGUP 

SCSUBCR 

SCSUBUP 

SCSUPCR 

SCSUPUP 

SCTRSPR 

SCTYPIN 

SCTYPUP 

SCUNIQUE 

SCUNQEST 

SCUNQPND 

SCUPDATE 

SORTKIND 

SORXNAME 

UPARRAY 

UPCLASS1 

UPCLASS2 

UPDEFTYP 

UPENTY1 

UPENTY2 

UPENUM 

UPFIELD 

UPINT 

UPLIST 

UPPNTR 

UPREAL 

UPSET 

UPSTRING 

UPSTRUC 

UPSUB1 


-  Builds  a  list  of  definitionss  for  REVIEW. 

-  Creates  a  POINTER  definition. 

-  Updates  a  POINTER  definition. 

-  Pushes  an  entry  on  the  stack  of  keys. 

-  Pushes  an  entry  on  the  stack  of  transactions. 

-  Creates  a  REAL  definition. 

-  Updates  a  REAL  definition. 

-  Determines  the  next  menu  for  the  selected  REVIEW  option. 

-  Determines  the  option  for  a  report  and  call  the  generation 
routine. 

-  Creates  a  SET  definition. 

-  Updates  a  SET  definition. 

-  Routine  called  by  MALSRT  to  order  attributes  by  position 
override  position. 

-  Updates  a  STRUCTURE  definition. 

-  Creates  a  STRING  definition. 

-  Updates  a  STRING  definition. 

-  Creates  a  SUBSCHEMA  definition. 

-  Updates  a  SUBSCHEMA  definition. 

-  Creates  a  SUPERTYPE  definition. 

-  Updates  a  SUPERTYPE  definition. 

-  Process  a  transaction  stack  entry. 

-  Writes  DEFINED  TYPE  definitions  for  the  PASCAL  Include  File. 

-  Updates  the  DEFINED  TYPE,  ARRAY,  or  ATTRIBUTE  data  type. 

-  Verifies  uniqueness  of  names  and  kind  numbers  within  the  Schema 
model. 

-  Calls  MAKXEQ  to  execute  SCUNQEST. 

-  Checks  the  transaction  stack  for  names  and  kind  numbers. 

-  Determines  the  next  menu  for  the  selected  UPDATE  option. 

-  The  ordering  function  called  by  MALSRT  for  kind  numbers. 

-  The  ordering  function  called  by  MALSRT  for  names. 

-  Displays  the  UPDATE  ARRAY  menu. 

-  Displays  the  first  UPDATE  CLASS  menu. 

-  Displays  the  second  UPDATE  CLASS  menu. 

-  Displays  the  UPDATE  DEFINED  TYPE  menu. 

-  Displays  the  first  UPDATE  ENTITY  menu. 

-  Displays  the  second  UPDATE  ENTITY  menu. 

-  Displays  the  UPDATE  ENUMERATION  menu. 

-  Displays  the  UPDATE  ATTRIBUTE  menu. 

-  Displays  the  UPDATE  INTEGER  menu. 

-  Displays  the  UPDATE  LIST  menu. 

-  Displays  the  UPDATE  POINTER  menu. 

-  Displays  the  UPDATE  REAL  menu. 

-  Displays  the  UPDATE  SET  menu. 

-  Displays  the  UPDATE  STRING  menu. 

-  Displays  the  UPDATE  STRUCTURE  menu. 

-  Displays  the  first  UPDATE  SUBSCHEMA  menu. 
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UPSUB2  -  Displays  the  second  UPDATE  SUBSCHEMA  menu. 

UPSUPER  -  Displays  the  UPDATE  SUPERTYPE  menu. 

XATTDATA  -  Cross-reference  by  data  type. 

XATTNAME  -  Cross-reference  by  name. 

XATTRES  -  Displays  cross-reference  results. 

XEXPREC  -  Generates  a  list  of  numeric  precisions  and  string  lengths. 

XFNDARY  -  Generates  a  list  of  ARRAY  data  types  (including  LIST,  SET). 

XFNDKEY  -  Determines  the  MAS  key  for  an  name  or  kind  number. 

XFNDNAME  -  Generates  a  list  of  ATTRIBUTES  with  a  given  name. 

XFNDPREC  -  Generates  a  list  of  numeric  data  type  of  a  given  precision  or 

strings  of  a  given  length. 

XLISTENT  -  Generates  a  list  of  aggregations  in  which  the  entity  is  a  member. 
XMAIN  -  Cross-reference  driver  routine. 

XMATTRES  -  Displays  a  cross-reference  menu. 

XMMAIN  -  Displays  a  cross-reference  menu. 

XMNAMSPE  -  Displays  a  cross-reference  menu. 

XMPRESPE  -  Displays  a  cross-reference  menu. 

XMRESULT  -  Displays  a  cross-reference  menu. 

XMTYPSPE  -  Displays  a  cross-reference  menu. 

XNAMENUM  -  Determines  whether  a  string  contains  a  name  or  a  number. 

XRESULT  -  Displays  the  cross-reference  report  results. 


3.10.1.2  Listings 

The  listings  begin  on  the  following  page. 
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(*  %INCLUDE  ADDENUM  *) 

(**) 

PROCEDURE  ADDENUM(VAR  MESS  :  MESSAGE; 

VAR  NAME  :  IDCHAR; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  ADD  ENUMERATION  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NAME  0  THE  NAME  OF  THE  ENUMERATION  FROM  PANEL  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  CREATE  ENUMERATION  PANEL  (ADDENUM)  BY  MAKING  *) 

(*  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  *) 

(*  ENUMERATED  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  *) 

(*  GATHERED  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  *) 

(*  PROCEDURE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  ADDFIELD  *) 

(**) 

PROCEDURE  ADDFIELD (VAR  MESS  :  MESSAGE; 

VAR  NAME  :  T_NAME; 

VAR  POS  :  CHAR8 ; 

(*  VAR  PURP  :  CHAR8 ;  *) 

VAR  REQD  :  CHAR8 ; 

(*  VAR  DEPD  :  CHAR8;  *) 

VAR  COM  :  CHAR50; 

VAR  FTYPE  :  ENTITY_TYPE; 

VAR  FLDTYP  :  T_FIELDTYPE ; 

VAR  NEXT_0P  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  ADDFIELD  PANEL  *) 

(*  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NAME  0  THE  NAME  OF  THE  FIELD  *) 

(*  POS  0  THE  PHYSICAL  POSITION  NUMBER  IN  THE  ADB  *) 

(*  PURP  0  THE  PURPOSE  OF  THE  FIELD  *) 

(*  REQD  0  REQUIREDNESS  OF  THE  FIELD  *) 

(*  DEPD  0  DEPENDENCE  OF  THE  FIELD  *) 

(*  FTYPE  0  THE  CONSTITUENT  ENTITY  TYPE  *) 

(*  FLDTYPE  0  THE  USER  ENTITY  TYPE  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 


^  _ 


3-180 


Cl  PS560240032U 
April  1990 


(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

DISPLAY  THE  ADD  FIELD  PANEL  (ADDFIELD)  BY 

MAKING  ISPLNK 

*) 

(* 

CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED 

*) 

(* 

TYPE. 

*) 

(* 

*) 

(* 

$ COMMENTS : 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

*) 

(* 

REVISED:  JANUARY  1988  C.  H.  MOHME 

DBMA 

*) 

(* 

MODIFIED  TO  INCORPORATE  THE  STRUCTURE  DATA 

TYPE. 

*) 

(* 

*) 

(* 

REVISED:  09/28/87  C.  H.  MOHME 

DBMA 

*) 

(* 

CHANGED  TO  INCORPORATE  THE  SUPERTYPE  FIELDS 

• 

*) 

(* 

*) 

(* 

REVISED:  08/13/87  C.  H.  MOHME 

DBMA 

*) 

<* 

CHANGED  PANEL  OPTION  NUMBERS;  CHANGED  FIELD 

ADB  DATA; 

ADDED 

*) 

(* 

LIST  AND  SET.  NOTE:  THE  LIST  AND  SET  DATA 

TYPES  ARE 

IMPLE- 

*) 

(* 

MENTED  IN  THE  SOFTWARE  AS  AN  ARRAY.  A  FIELD 

i  WAS  ADDED  TO  THE 

*) 

(* 

ARRAY  ADB  TO  SPECIFY  WHETHER  THE  ARRAY  IS  A 

CONCEPTUAL  ARRAY, 

*) 

(* 

LIST,  OR  SET. 

*) 

(* 

*) 

(* 

REVISED:  07/02/87  C.  H.  MOHME 

DBMA 

*) 

(* 

CHANGED  CURSOR  POSITIONING. 

*) 

(* 

*) 

(* 

ORIGINATED:  07/30/86  C.  H.  MOHME 

DBMA 

*) 

(* 

*) 

(*~ 

— 

— 

— 

-*) 

(* 

*) 

(*END - 

— 

— 

-*) 

(*  END  %INCLUDE  ADDFIELD  *) 
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(*  %INCLUDE  APPROVE  *) 
(**) 


PROCEDURE  APPROVE (VAR  MESS  :  MESSAGE; 

VAR  NAME  :  T_NAME; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  PROCEDURE  :  *) 

(*  DISPLAYS  THE  APPROVE  UPDATE  PANEL  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NAME  I  THE  NAME  OF  THE  ENTITY  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  APPROVE  UPDATE  PANEL  (APPROVE)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  *) 

(*  *) 

(*  $ COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 


> 
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(*  %INCLUDE  BATDVR  *) 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  IS  THE  MAINLINE  PROGRAM  WHICH  DRIVES  THE  BATCH  *) 

(*  INTERFACE  OF  THE  SCHEMA  MANAGER.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  SOURCE  =  INPUT  FILE  OF  SCHEMA  DEFINITIONS  IN  THE  *) 

(*  EXPRESS  INFORMATION  MODELING  LANGUAGE  *) 

(*  *) 

(*  REPORT1  =  OUTPUT  FILE  OF  ACTIONS  TAKEN  DURING  THE  *) 

(*  BATCH  PROCESSING.  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  BEGIN  %INCLUDE  BATERR  **********************************************) 


Const  Expected 

T_Expected; 

Var 

Ent_Kind 

Integer; 

Var 

Token 

T_Token; 

Var 

Token_Value 

T_Token_Value ; 

Var 

Token_Location 

Integer; 

Var 

Token_Length 

Integer; 

Var 

Reportl 

Text  ); 

EXTERNAL; 

^FUNCTION: 

Error  reporting  and  recovery  for  Batch  Interface. 


^DESCRIPTION  OF  ARGUMENTS: 


DESCRIPTION 


Ent_Kind 

Expected 


Reportl 

Token 

Token_Length 
Token  Location 


Token  Value 


Kind  of  entity  being  constructed  *) 

Record  containing:  *) 

Entries:  Number  of  entries  *) 

in  array  *) 

TokenJValue:  Array  of  expected  *) 

token  values  *) 

Error  messages  *) 

Input:  unrecognized  token  *) 

Output:  first  recognized  token  *) 

Input:  length  of  unrecognized  token  *) 
Output:  length  of  recognized  token  *) 
Input:  location  of  unrecognized  *) 
token  *) 

Output:  location  of  recognized  token  *) 
Input:  value  of  unrecognized  token  *) 
Output:  value  of  recognized  token  *) 


^COMMONS : 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL/VS  SEGMENT 
HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

Internal  routine  for  Batch  Interface  of  the  Schema  Manager 

^PROCESSING  DESCRIPTION: 

Highlight  the  unrecognized  token. 

List  the  expected  tokens. 
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(*  Highlight  the  tokens  ignored  while  searching  for  a  *) 

(*  recognized  token.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  ORIGINATED:  7  December  1987,  G.  A.  White  *) 

(*  REVISED:  <date,  responsible  person,  reason/description>  *) 

(*  *) 


(*  END  %INCLUDE  BATERR  *********************************************) 
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(*  ^INCLUDE  BATRPT  *) 

(**) 

PROCEDURE  BATRPT (VAR  IRC 

VAR  TOKEN 
VAR  TOKEN_VALUE 
VAR  REPORT! 

SUBPROGRAM; 

(**) 


RET_REC ; 
T_TOKEN ; 
T_TOKEN_VALUE; 
TEXT).; 


^FUNCTION: 

BATCH  INTERFACE  ROUTINE  THAT  INVOKES  THE  NECESSARY  ROUTINES 
TO  GENERATE  THE  SPECIFIED  REPORT. 


^DESCRIPTION  OF  ARGUMENTS: 


DESCRIPTION 


IRC 

TOKEN 

TOKEN.VALUE 

TEXT 


INTERNAL  RETURN  CODE 
TOKEN  FROM  BATCH  INPUT 
TOKEN  VALUE  FROM  BATCH  INPUT 
OUTPUT  FILE 


^COMMONS : 


^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT 

^PROCESSING  DESCRIPTION: 

PERFORM  INITIALIZATIONS 
GET  THE  REPORT  TYPE 

IF  THE  REPORT  TYPE  IS  NOT  CONCEPTUAL  SCHEMA,  THEN  GET  THE 
SUBSCHEMA  NAME. 

GET  THE  SUBSCHEMA  KEY  AS  APPROPRIATE  AND  GENERATE  A  REPORT 

GET  THE  SUBSCHEMA  KEY 

PHYSICALIZE  THE  SUBSCHEMA,  IF  NECESSARY 

IF  REPORT  TYPE  IS  PASCAL  INCLUDES,  THEN  GENERATE  THE  PASCAL 
INCLUDE  FILES, 

IF  REPORT  TYPE  IS  DATA  DICTIONAY,  THEN  GENERATE  THE  DATA 
DICTIONARY. 

IF  REPORT  TYPE  IS  PHYSICAL  SUBSCHEMA,  THEN  GENERATE 
THE  PHYSICAL  SUBSCHEMA  REPORT. 

PRINT  ERROR  MESSAGES  AS  APPROPRIATE 
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(*  IF  REPORT  TYPE  IS  CONCEPTUAL  SCHEMA,  THEN  GENERATE  THE  *) 

(*  CONCEPTUAL  SCHEMA  REPORT  *) 


(*  PRINT  ERROR  MESSAGES  AS  APPROPRIATE 

(*  GET  THE  NEXT  TOKEN 

(* 

(*  ^COMMENTS: 

(* 

(*  $ CHANGE  CONTROL: 

(* 

(*  ORIGINATED:  06/09/87  C.  H.  MOHME 

(* 

(* - 

(* 

(*END - ^ - 

(*  END  %INCLUDE  BATRPT  *) 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

DBMA  *) 

*) 

- *) 

*) 

- *) 
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(*  %INCLUDE  BCSMAIN  *) 

(**) 

PROCEDURE  BCSMAIN(VAR  IRC  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  SERVES  AS  THE  MAIN  DRIVER  FOR  THE  CONCEPTUAL  *) 

(*  SCHEMA  REPORT.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  350/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INITIALIZE  THE  VARIABLES  USED  WITHIN  THIS  ROUTINE.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  REPORT  COVER.  *) 

(*  INITIALIZE  THE  PAGE  NUMBER  AND  PAGE  CHAIN.  *) 

(*  MAKE  A  LIST  OF  DEFINED  TYPES  WITHIN  THE  SCHEMA.  *) 

(*  ALPHABETIZE  THE  LIST  OF  DEFINED  TYPES.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  DEFINED  TYPES  WITHIN  THE  SCHEMA.  *) 

(*  DELETE  THE  LIST  OF  DEFINED  TYPES  WITHIN  THE  SCHEMA.  *) 

(*  MAKE  A  LIST  OF  GLOBAL  FIELDS  WITHIN  THE  SCHEMA.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  GLOBAL  FIELDS  WITHIN  THE  SCHEMA.  *) 

(*  DELETE  THE  LIST  OF  GLOBAL  FIELDS  WITHIN  THE  SCHEMA.  *) 

(*  MAKE  A  LIST  OF  ENTITIES  WITHIN  THE  SCHEMA.  *) 

(*  ALPHABETIZE  THE  LIST  OF  ENTITIES.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  ENTITIES  WITHIN  THE  SCHEMA.  *) 

(*  MAKE  A  LIST  OF  CLASSES  WITHIN  THE  SCHEMA.  *) 

(*  ALPHABETIZE  THE  LIST  OF  CLASSES.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  CLASSES  WITHIN  THE  SCHEMA.  *) 

(*  MAKE  A  LIST  OF  SUBSCHEMAS  WITHIN  THE  SCHEMA.  *) 

(*  ALPHABETIZE  THE  LIST  OF  SUBSCHEMAS.  *) 
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(*  WRITE  OUT  TO  THE  FILE  THE  SUBSCHEMAS  WITHIN  THE  SCHEMA.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  ENTITY  INDEX.  *) 

(*  DELETE  THE  LIST  OF  ENTITIES.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  CLASS  INDEX.  *) 

(*  DELETE  THE  LIST  OF  CLASSES.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  SUBSCHEMA  INDEX.  *) 

(*  DELETE  THE  LIST  OF  SUBSCHEMAS.  *) 

(*  IF  NO  MODEL  EXISTS,  WRITE  APPROPRIATE  MESSAGE.  *) 

(*  DISPOSE  OF  POINTERS  USED  IN  THIS  ROUTINE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  WITHIN  THE  INCLUDE  FILE  'CSTYPCON',  ONE  CAN  SET  THE  MAXIMUM  *) 
(*  NUMBER  OF  LINES  PER  PAGE  IN  THE  REPORT.  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  BLDARRAY  *) 

(**) 

PROCEDURE  BLDARRAY (VAR  IRC  :  RET_REC; 

CONST  ARRAY_DATA  :  TRANSACTION; 
CONST  CNST_KEY  :  ENTKEY; 

VAR  ARRAY_KEY  :  ENTKEY); 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  BUILDS  THE  ARRAY  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  ARRAY_DATA  I  TRANSACTION  DATA  OF  THE  ARRAY  ENTITY  *) 

(*  CNSTJCEY  I  KEY  TO  THE  CONSTITUENT  *) 

(*  ARRAY_KEY  0  KEY  TO  THE  ARRAY  ENTITY  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  A  LIST  IS  MADE  OF  ALL  THE  ARRAY  ENTITIES.  IF  THE  LIST  IS  *) 

(*  NOT  EMPTY  THEN  IT  IS  SEARCHED  FOR  A  MATCH.  IF  THE  BOUNDS  *) 


(*  ARE  IDENTICAL  THE  CONSTITUENT  KEYS  ARE  COMPARED.  IF  THESE  *) 
(*  MATCH  THE  KEY  TO  THE  ARRAY  ENTITY  THAT  IS  IDENTICAL  TO  THE  *) 
(*  ONE  TO  BE  CREATED  IS  PASSED  BACK  TO  THE  CALLING  PROCEDURE.  *) 
(*  THE  LIST  IS  SEARCHED  UNTIL  A  MATCH  IS  MADE  OR  THE  END  OF  *) 
(*  •  THE  LIST  IS  ENCOUNTERED.  IF  NO  MATCH  IS  FOUND  THE  ARRAY  *) 
(*  ENTITY  IS  CREATED  USING  MAS.  *) 


(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 


3-190 


Cl  PS560240032U 
April  1990 


(*  %INCLUDE  BLDBPDEF  *) 

<**) 

PROCEDURE  BLDBPDEF(VAR  IRC 

VAR  IDENTIFIER 
VAR  KIND 

VAR  REFERENCEJCEY 
VAR  DEFINITION  KEY 


RET_REC; 
T_NAME; 
INTEGER; 
ENT KEY; 
ENTKEY) ; 


SUBPROGRAM; 

(**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  BUILDS  THE  BACKPATCH  ENTITY. 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 

(*  NAME  I/O  DESCRIPTION 

(*  IRC  0 

(*  IDENTIFIER  I 

(*  KIND  I 

(*  REFERENCE_KEY  I 

(* 

(*  DEFINITIONJCEY  0 

(* 

(* 

(*  ^COMMONS: 

(*  NONE 

(* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(*  THE  BACKPATCH  ENTITY  IS  CREATED  USING  MAS  ROUTINES 

<* 

(*  ^COMMENTS: 

(*  NONE 

(* 

(*  $ CHANGE  CONTROL: 

(* 


INTERNAL  RETURN  CODE 
ENTITY  NAME 
ENTITY  KIND  NUMBER 

THE  KEY  TO  THE  ENTITY  THAT  REFERENCES 

THE  UNRESOLVED  ENTITY 

THE  KEY  TO  THE  CREATED  BACKPATCH 

ENTITY 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  BLDCLASS  *) 

(**) 

PROCEDURE  BLDCLASS (VAR  IRC  :  RET_REC ; 

CONST  CLASS_DATA  :  TRANSACTION; 

VAR  CLASS_KEY  :  ENTKEY); 

SUBPROGRAM; 

(**) 

(* - - - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  BUILDS  THE  CLASS  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  CLASS_DATA  I  TRANSACTION  DATA  OF  THE  CLASS  ENTITY  *) 

(*  CLASSJCEY  0  KEY  TO  THE  CLASS  ENTITY  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  REF  *) 

(*  CURRENT_LIST  I/O  LIST  CURRENTLY  IN  USE  CONTAINING  THE  *) 

(*  CONSTITUENTS  OF  THE  CLASS  ENTITY  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THE  ADB  DATA  IS  ASSIGNED  TO  VARIABLES  THEN  THE  MAS  *) 

(*  ROUTINE  MAECR  IS  CALLED  TO  CREATE  THE  CLASS  ENTITY.  *) 

(*  *) 

(*  $ COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  BLDCLS  *) 

(**) 

PROCEDURE  BLDCLS (VAR  IRC 

VAR  TRANS_STACK 
VAR  CLASS_FLAG 
VAR  CLS_ENT_HEAD 

SUBPROGRAM; 

(**) 

(* - 

(* 

<* 

(* 


(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


RET_REC ; 

TRANSPTR; 

BOOLEAN; 

ENTITY_LIST_PTR); 


^FUNCTION: 

BATCH  INTERFACE  ROUTINE  THAT  CREATES  A  CLASS  ENTITY  IN  THE 


-*) 

*) 

*) 

*) 


(* 

SCHEMA  MODEL  : 

FROM  A  CLASS  NAME,  KIND  NUMBER,  AND  LIST  OF 

*) 

(* 

CONSTITUENTS . 

*) 

(* 

*) 

<* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

(* 

NAME 

I/O 

DESCRIPTION 

*) 

\ 

(* 

IRC 

0 

INTERNAL  RETURN  CODE 

*) 

*) 

(* 

TRANS_STACK 

I/O 

TRANSACTION  STACK 

*) 

(* 

CLASS_FLAG 

I/O 

INDICATES  IF  ENTITITIES  AND  CLASSES  ARE 

*) 

(* 

DEFINED  WITHIN  THE  CLASS 

*) 

(* 

CLS_ENT_HEAD 

I/O 

POINTER  TO  LIST  OF  CLASS  ENTITIES 

*) 

(* 

*) 

(* 

^COMMONS : 

*) 

(* 

*) 

(* 

^ENVIRONMENT : 

*) 

(* 

LANGUAGE:  IBM 

PASCAL 

*) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 
^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT 
^PROCESSING  DESCRIPTION: 

INITIALIZE  VARIABLES 

REMOVE  CLASS  NAME  AND  NUMBER  FROM  LIST  AND  PUSH  THEM  ONTO 
TRANSACTION  STACK 

REMOVE  EACH  ENTITY  KEY  FROM  THE  LIST  AND  PUSH  THEM  ONTO  TRANS¬ 
ACTION  STACK 

PUSH  FINAL  CLASS  TRANSACTION  ONTO  THE  STACK  AND  PROCESS  THE 
STACK. 

REINITIALIZE  VARIABLES 
$ COMMENTS: 

^CHANGE  CONTROL: 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 
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(*  *) 

(*  ORIGINATED:  03/20/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  BLDCLS  *) 
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(*  %INCLUDE  BLDDFTYP  *) 

('**) 

PROCEDURE  BLDDFTYP(VAR  IRC  :  RET_REC; 

CONST  DEFINED_TYPE_DATA  :  TRANSACTION; 
CONST  CNST_KEY  :  ENTKEY; 

VAR  DEFINED_TYPE_KEY  :  ENTKEY); 


(**) 

(* _ 

V 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


SUBPROGRAM; 


$ FUNCTION: 

THIS  ROUTINE  BUILDS  THE  DEFINED  TYPE  ENTITY. 


^DESCRIPTION  OF  ARGUMENTS: 


NAME 

IRC 

DEFINED_TYPE_DATA 

CNST_KEY 

DEFINED  TYPE  KEY 


I/O  DESCRIPTION 

0  INTERNAL  RETURN  CODE 
I  TRANSACTION  DATA  OF  THE  DEFINED 
TYPE  ENTITY 

I  KEY  TO  THE  CONSTITUENT 
0  KEY  TO  THE  DEFINED  TYPE  ENTITY 


$COMMONS : 

NONE 

^ENVIRONMENT : 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 
^PROCESSING  DESCRIPTION: 

THE  ADB  DATA  IS  ASSIGNED  AND  THEN  THE  MAS  ROUTINE  MAECR 
IS  CALLED  TO  MODEL  THE  DEFINED  TYPE  ENTITY. 

$ COMMENTS : 

NONE 

$ CHANGE  CONTROL: 


-*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*> 

*) 

*) 

*) 

*) 

*) 

*; 

*) 

*) 

*> 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 
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(*  %INCLUDE  BLDEITEM  *) 

(**) 

PROCEDURE  BLDEITEM(VAR  IRC  :  RET_REC; 

CONST  ENUMERITEM_DATA  :  TRANSACTION; 

VAR  ENUMERITEM_KEY  :  ENTKEY) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  BUILDS  THE  ENUMERITEM  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  ENUMERITEM_DATA  I  TRANSACTION  DATA  OF  THE  ENUMERITEM  *) 

(*  ENTITY  *) 

(*  ENUMERITEM_KEY  0  KEY  TO  THE  ENUMERITEM  ENTITY  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

<*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  A  LIST  IS  MADE  OF  ALL  THE  ENUMERITEM  ENTITIES.  *) 

(*  IF  THE  LIST  IS  NOT  EMPTY  THEN  IT  IS  SEARCHED  FOR  A  MATCH  *) 

(*  UNTIL  ONE  IS  FOUND  OR- THE  END  OF  THE  LIST  IS  REACHED.  *) 

(*  IF  A  MATCH  IS  FOUND  ITS  KEY  IS  PASSED  BACK  TO  THE  CALLING  *) 

(*  PROCEDURE  OTHERWISE  A  NEW  ENUMERITEM  ENTITY  IS  CREATED.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  ,  NONE  *) 

(*  *) 

(*  $CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  BLDENT  *) 
(**) 


PROCEDURE  BLDENT (VAR  IRC  :  RET_REC; 

CONST  ENTITY_DATA  :  TRANSACTION; 
VAR  ENTITY_KEY  :  ENTKEY); 

SUBPROGRAM; 

(**) 

(* - 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

<* 


^FUNCTION: 

THIS  ROUTINE  BUILDS  THE  ENTITY  ENTITY. 


^DESCRIPTION  OF  ARGUMENTS: 
NAME  I/O 


DESCRIPTION 


IRC 

ENTITY_DATA 

ENTITY_KEY 


0  INTERNAL  RETURN  CODE 
I  TRANSACTION  DATA  OF  THE  ENTITY  ENTITY 
0  KEY  TO  THE  ENTITY  ENTITY 


$ COMMONS : 

REF 

CURRENTJLIST  I/O  LIST  CURRENTLY  IN  USE  CONTAINING  THE 

CONSTITUENTS  OF  THE  ENTITY  ENTITY 


^ENVIRONMENT : 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 


^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 


^PROCESSING  DESCRIPTION: 

THE  ADB  DATA  IS  ASSIGNED  TO  VARIABLES  THEN  THE  MAS 
ROUTINE  MAECR  IS  CALLED  TO  CREATE  THE  ENTITY  ENTITY. 

$  COMMENTS: 

NONE 


$ CHANGE  CONTROL: 


-*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 
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(*  %INCLUDE  BLDENUMR  *) 

(**) 

PROCEDURE  BLDENUMR (VAR  IRC  :  RET_REC; 

VAR  ENUMERATION_KEY  :  ENTKEY) ; 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  BUILDS  THE  ENUMERATION  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  ENUMERATIONJCEY  0  KEY  TO  THE  ENUMERATION  ENTITY  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  REF  *) 

(*  CURRENT_LIST  I/O  A  KEY  TO  THE  LIST  OF  CONSTITUENTS  *) 

(*  *) 

(*  "  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THE  ADB  DATA  IS  ASSIGNED,  AND  THEN  THE  KEY  TO  THE  COMMON  *) 

(*  CURRENT_LIST,  WHICH  CONTAINS  THE  ENUMERATION  CONSTITUENTS,  *) 

(*  AS  WELL  AS  THE  ADB  IS  PASSED  TO  THE  MAS  ROUTINE  MAECR  *) 

(*  WHICH  MODELS  THE  ENUMERATION  ENTITY.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  BLDFIELD  *) 

(**) 

PROCEDURE  BLDFIELD (VAR  IRC  :  RET_REC; 

CONST  FIELD_DATA  :  TRANSACTION; 
CONST  CNST_KEY  :  ENTKEY; 

VAR  FIELD_KEY  :  ENTKEY); 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION;  *) 

(*  THIS  ROUTINE  BUILDS  THE  FIELD  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  FIELD JDATA  I  TRANSACTION  DATA  OF  THE  FIELD  ENTITY  *) 

(*  CNSTJCEY  I  KEY  TO  THE  CONSTITUENT  *) 

(*  FIELD_KEY  0  KEY  TO  THE  FIELD  ENTITY  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

C*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE;  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  .^PROCESSING  DESCRIPTION:  *) 

(*  THE  ADB  DATA  IS  ASSIGNED  AND  THEN  THE  MAS  ROUTINE  MAECR  *) 

(*  IS  CALLED  TO  MODEL  THE  FIELD  ENTITY.  *) 

(*  *) 

(*  $ COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  BLDGBLFD  *) 

(**) 

PROCEDURE  BLDGBLFD (VAR  IRC  :  RET_REC; 

CONST  GLOBAL_DATA  :  TRANSACTION; 

VAR  GLOBAL_FIELD_KEY  :  ENTKEY) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  BUILDS  THE  GLOBAL  FIELD  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  GLOBAL_DATA  I  GLOBAL  FIELD  DATA  *) 

(*  GLOBAL_FIELD_KEY  0  KEY  TO  THE  GLOBAL  FIELD  ENTITY  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  REF  *) 

(*  CURRENT_LIST  I/O  LIST  CURRENTLY  IN  USE  CONTAINING  THE  *) 

(*  CONSTITUENTS  OF  THE  GLOBAL  FIELD  *) 

(*  ENTITY  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THE  ADB  DATA  IS  ASSIGNED  TO  VARIABLES  THEN  THE  MAS  *) 

(*  ROUTINE  MAECR  IS  CALLED  TO  CREATE  THE  GLOBAL  FIELD  *) 

(*  ENTITY.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  BLDINT  *) 

<**) 

PROCEDURE  BLDINT (VAR  IRC  :  RET_REC; 

CONST  INTEGER_DATA  :  TRANSACTION; 

VAR  INTEGER_KEY  :  ENTKEY) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  BUILDS  THE  INTEGER  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  INTEGER JDATA  I  TRANSACTION  DATA  OF  THE  INTEGER  ENTITY  *) 

(*  INTEGER  KEY  0  KEY  TO  THE  INTEGER  ENTITY  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

<*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  A  LIST  IS  MADE  OF  ALL  THE  INTEGER  ENTITIES.  *) 

(*  IF  THE  LIST  IS  NOT  EMPTY  THEN  IT  IS  SEARCHED  FOR  A  MATCH  *) 

(*  UNTIL  ONE  IS  FOUND  OR  THE  END  OF  THE  LIST  IS  REACHED.  *) 

(*  IF  A  MATCH  IS  FOUND  ITS  KEY  IS  PASSED  BACK  TO  THE  CALLING  *) 

(*  PROCEDURE  OTHERWISE  A  NEW  INTEGER  ENTITY  IS  CREATED.  *) 

(*  *) 

(*  $ COMMENTS :  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

<*  *) 
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(*  %INCLUD£  BLDLOG  *) 

(**) 

PROCEDURE  BLDLOG (VAR  IRC  :  RET_REC; 

VAR  LOGICAL_KEY  :  ENTKEY) ; 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  BUILDS  THE  LOGICAL  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  LOGICAL  KEY  0  KEY  TO  THE  LOGICAL  ENTITY  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

<*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  A  LIST  IS  MADE  OF  ALL  THE  LOGICAL  ENTITIES.  *) 

(*  IF  THE  LIST  IS  NOT  EMPTY  THEN  A  LOGICAL  ENTITY  IS  CREATED,  *) 

(*  OTHERWISE  THE  KEY  TO  THE  EXISTING  LOGICAL  ENTITY  IS  *) 

(*  PASSED  BACK  TO  THE  CALLING  PROCEDURE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  BLBPNTR  *) 

(**) 

PROCEDURE  BLDPNTR(VAR  IRC  :  RET_REC; 

VAR  POINTER_KEY  :  ENTKEY) ; 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  BUILDS  THE  POINTER  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  POINTER  KEY  0  KEY  TO  THE  POINTER  ENTITY  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  REF  *) 

(*  CURRENT.LIST  I/O  LIST  CURRENTLY  IN  USE  CONTAINING  THE  *) 

(*  CONSTITUENTS  OF  THE  POINTER  ENTITY  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THE  ADB  DATA  IS  ASSIGNED  TO  VARIABLES  THEN  THE  MAS  *) 

(*  ROUTINE  MAECR  IS  CALLED  TO  CREATE  THE  POINTER  ENTITY.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

<*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  BLDREAL  *) 

(**) 

PROCEDURE  BLDREAL (VAR  IRC  :  RET_REC; 

CONST  REAL_DATA  :  TRANSACTION; 
VAR  REAL_KEY  :  ENTKEY) ; 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  BUILDS  THE  REAL  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  REAL_DATA  I  TRANSACTION  DATA  OF  THE  REAL  ENTITY  *) 

(*  REALJCEY  0  KEY  TO  THE  REAL  ENTITY  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

<*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  A  LIST  IS  MADE  OF  ALL  THE  REAL  ENTITIES.  *) 

(*  IF  THE  LIST  IS  NOT  EMPTY  THEN  IT  IS  SEARCHED  FOR  A  MATCH  *) 

(*  UNTIL  ONE  IS  FOUND  OR  THE  END  OF  THE  LIST  IS  REACHED.  *) 

(*  IF  A  MATCH  IS  FOUND  ITS  KEY  IS  PASSED  BACK  TO  THE  CALLING  *) 

(*  PROCEDURE  OTHERWISE  A  NEW  REAL  ENTITY  IS  CREATED.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  7.INCLUDE  BLDSSCMA  *) 

(**) 

PROCEDURE  BLDSSCMA(VAR  IRC  :  RET_REC; 

CONST  SUBSCHEMA_DATA  :  TRANSACTION; 
VAR  SUBSCHEMA_KEY  :  ENTKEY) ; 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  BUILDS  THE  SUBSCHEMA  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  SUBS CHEMA_DATA  I  TRANSACTION  DATA  OF  THE  SUBSCHEMA  *) 

(*  ENTITY  *) 

(*  SUBS CHEMA_KE Y  0  KEY  TO  THE  SUBSCHEMA  ENTITY  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  REF  *) 

(*  CURRENT_LIST  I/O  LIST  CURRENTLY  IN  USE  CONTAINING  THE  *) 

(*  CONSTITUENTS  OF  THE  SUBSCHEMA  ENTITY  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THE  ADB  DATA  IS  ASSIGNED  TO  VARIABLES  THEN  THE  MAS  *) 

(*  ROUTINE  MAECR  IS  CALLED  TO  CREATE  THE  SUBSCHEMA  ENTITY.  *) 

(*  '  *) 
(*  $ COMMENTS :  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  BLDSTRNG  *) 

(**) 

PROCEDURE  BLDSTRNG(VAR  IRC  :  RET_REC; 

CONST  STRING_DATA  :  TRANSACTION; 
VAR  STRING_KEY  :  ENTKEY) ; 

SUBPROGRAM; 

(**) 


(* - *) 

<*  *) 
(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  BUILDS  THE  STRING  ENTITY.  *) 
(*  *) 
(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 
(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 
(*  STRING_DATA  I  TRANSACTION  DATA  OF  THE  STRING  ENTITY  *) 
(*  STRINGJKEY  0  KEY  TO  THE  STRING  ENTITY  *) 

(*  *) 
(*  ^COMMONS:  *) 

(*  NONE  *) 
(*  *) 
(*  ^ENVIRONMENT:  *) 
(*  LANGUAGE:  IBM  PASCAL  *) 
(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 
(*  *) 
(*  ^EXECUTION  PROCEDURE:  *) 
(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 
(*  *) 
(*  ^PROCESSING  DESCRIPTION:  *) 
(*  A  LIST  IS  MADE  OF  ALL  THE  STRING  ENTITIES.  *) 
(*  IF  THE  LIST  IS  NOT  EMPTY  THEN  IT  IS  SEARCHED  FOR  A  MATCH  *) 
(*  UNTIL  ONE  IS  FOUND  OR  THE  END  OF  THE  LIST  IS  REACHED.  *) 
(*  IF  A  MATCH  IS  FOUND  ITS  KEY  IS  PASSED  BACK  TO  THE  CALLING  *) 
(*  PROCEDURE  OTHERWISE  A  NEW  STRING  ENTITY  IS  CREATED.  *) 

(*  *) 
(*  ^COMMENTS:  *) 

(*  NONE  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 
(*  *) 
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<*  %INCLUDE  BLDSTRUC  *) 

(**) 

PROCEDURE  BLDSTRUC (VAR  IRC  :  RETJREC; 

VAR  STRUCTURE_KEY  :  ENTKEY) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  BUILDS  THE  STRUCTURE  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  STRUCTURE_KEY  0  KEY  TO  THE  STRUCTURE  ENTITY  *) 

(*  *) 

(*  | COMMONS :  *) 

(*  REF  *) 

(*  CURRENT_LIST  I/O  LIST  CURRENTLY  IN  USE  CONTAINING  THE  *) 

(*  CONSTITUENTS  OF  THE  STRUCTURE  ENTITY  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING'  DESCRIPTION:  *) 

(*  THE  ADB  DATA  IS  ASSIGNED  TO  VARIABLES  THEN  THE  MAS  *) 

(*  ROUTINE  MAECR  IS  CALLED  TC  CREATE  THE  STRUCTURE  ENTITY.  *) 

(*  *) 

(*  $ COMMENTS :  *) 

(*  NONE  *) 

<*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  BLDSUB  *) 

(**) 

PROCEDURE  BLDSUB (VAR  IRC  :  RET_REC ; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  SUBS CHEMA_FLAG  :  BOOLEAN; 

VAR  SUB_ENT_HEAD  :  ENTITY_LIST_PTR) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  BATCH  INTERFACE  ROUTINE  THAT  CREATES  A  SUBSCHEMA  ENTITY  IN  *) 

(*  THE  SCHEMA  MODEL  FROM  A  SUBSCHEMA  NAME  AND  LIST  OF  *) 

(*  CONSTITUENTS.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  TRANSACTION  STACK  *) 

(*  SUBSCHEMA_FLAG  I/O  INDICATES  IF  ENTITIES  AND  CLASSES  ARE  *) 

(*  DEFINED  WITHIN  THE  SUBSCHEMA  *) 

(*  SUB_ENT_HEAD  I/O  POINTER  TO  LIST  OF  SUBSCHEMA  ENTITIES  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INITIALIZE  VARIABLES  *) 

(*  REMOVE  SUBSCHEMA  NAME  FROM  LIST  AND  PUSH  IT  ONTO  TRANSACTION  *) 

(*  STACK  *) 

(*  >  REMOVE  EACH  ENTITY  KEY  FROM  THE  LIST  AND  PUSH  THEM  ONTO  TRANS-  *) 
(*  ACTION  STACK  *) 

(*  PUSH  FINAL  SUBSCHEMA  TRANSACTION  ONTO  THE  STACK  AND  PROCESS  *) 

(*  THE  STACK  *) 

(*  REINITIALIZE  THE  VARIABLES  *) 

(*  *) 
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(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  03/20/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  BLDSUB  *) 
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(*  %INCLUDE  BLDSUPER  *) 

(**) 

PROCEDURE  BLDSUPER(VAR  IRC  :  RET_REC; 

CONST  SUPERTYPE_DATA  :  TRANSACTION} 
VAR  SUPERTYPE_KEY  :  ENTKEY); 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  BUILDS  THE  SUPERTYPE  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  SUPERTYPEJDATA  I  TRANSACTION  DATA  OF  THE  SUPERTYPE  *) 

(*  ENTITY  *) 

(*  SUPERTYPEJCEY  0  KEY  TO  THE  SUPERTYPE  ENTITY  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  REF  *) 

(*  CURRENT_LIST  I/O  LIST  CURRENTLY  IN  USE  CONTAINING  THE  *) 

(*  CONSTITUENTS  OF  THE  ENTITY  ENTITY  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THE  ADB  DATA  IS  ASSIGNED  TO  VARIABLES  THEN  THE  MAS  *) 

(*  ROUTINE  MAECR  IS  CALLED  TO  CREATE  THE  ENTITY  ENTITY.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  BLDUNRES  *) 

(**) 

PROCEDURE  BLDUNRES (VAR  IRC  :  RET_REC; 

VAR  UNRESOLVED_DATA  :  TRANSACTION; 
VAR  UNRESOLVED_KEY  :  ENT KEY) ; 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  BUILDS  THE  UNRESOLVED  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  UNRESOLVED_DATA  0  TRANSACTION  DATA  OF  THE  UNRESOLVED  *) 

(*  ENTITY  *) 

(*  UNRESOLVEDJCEY  0  KEY  TO  THE  UNRESOLVED  ENTITY  *) 

<*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  CREATE  THE  UNRESOLVED  ENTITY  BY  CALLING  MAS  ROUTINES.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

<*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 


3-211 


Cl  PS560240032U 
April  1990 


(*  %INCLUDE  BLEXICAL  *) 

(**) 

PROCEDURE  BLEXICAL(  VAR  TOKEN  :  T_TOKEN; 

VAR  TOKEN_VALUE  :  T_TOKEN_VALUE ; 

VAR  TOKEN_LOCATION  :  INTEGER; 

VAR  TOKEN_LENGTH  :  INTEGER; 

VAR  REPORT1  :  TEXT); 

SUBPROGRAM; 

(*  *) 

(*  $ FUNCTION:  *) 

(*  LOCATE  THE  LONGEST  POSSIBLE  LEXEME  FROM  WHICH  A  TOKEN  MAY  *) 

(*  BE  DETERMINED,  EXCLUDING  COMMENTS.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  TOKEN  I/O  INPUT  =  TOKEN  TYPE  FROM  PREVIOUS  CALL  *) 

(*  OR  INITIALIZATION  FLAG  *) 

(*  OUTPUT  =  CURRENT  TOKEN  TYPE  *) 

(*  TOKENJ/ALUE  0  CURRENT  TOKEN  VALUE  *) 

(*  TOKENJLOCATION  0  START  LOCATION  OF  TOKEN  IN  REPORT  LINE  *) 

(*  TOKENLENGTH  0  LENGTH  OF  TOKEN  IN  REPORT  LINE  *) 

C*  REPORT1  0  REPORT  FILE  FOR  ECHOING  THE  INPUT  AND  *) 

(*  REPORTING  ERROR  MESSAGES  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  LOOP  UNTIL  TOKEN  IS  NOT  A  COMMENT  *) 

(*  GET  NEXT  TOKEN  *) 

(*  END  LOOP  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  03/26/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(*  REVISED:  7  DEC  87,  G,  A.  WHITE,  ADD  PARAMETERS  FOR  *) 
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^  location  AND  LENGTH  OF  TOKEN  IN  REPORT  LINE.  *) 

(* -  *) 

(*  *) 

(*END -  _  *) 

(*  END  %INCLUDE  BLEXICAL  *) 
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(*  ^INCLUDE  BSCINCLD  *) 

(**) 

PROCEDURE  BSCINCLD(VAR  IRC  :  RET_REC ; 

VAR  SUBSCHEMA_KEY  :  ENTKEY) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GENERATES  THE  PASCAL  INCLUDE  FILES  AND  WRITES  *) 

(*  THESE  DEFINITIONS  TO  A  FILE  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  I/O  RETURN  CODE  *) 

(*  MSG  I/O  PANEL  MESSAGE  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

<*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  A  PANEL  CONTAINING  A  LIST  OF  ALL  OF  THE  SUBSCHEMAS  *) 

(*  WITHIN  THE  SCHEMA  MODEL.  *) 

(*  IF  RETURN  OR  EXIT  WAS  NOT  CHOSEN  ON  THE  PANEL  THEN  *) 

(*  IF  A  MULTIPLE  SELECT  WAS  MADE  ON  THE  PANEL  THEN  *) 

(*  DISPLAY  AN  ERROR  MESSAGE  *) 

(*  ELSE  *) 

(*  GET  THE  KEY  OF  THE  SUBSCHEMA  SELECTED  *) 

(*  IF  THE  SUBSCHEMA  HAS  NOT  BEEN  PHYSICALIZED  THEN  *) 

(*  PHYSICALIZE  THE  SUBSCHEMA  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  HEADING  FOR  THE  INCLUDES  *) 

(*  MAKE  AN  INCLUSIVE  LIST  OF  ENTITIES  WITHIN  THE  SUBSCHEMA  *) 

(*  DELETE  ANY  DUPLICATES  ON  THE  LIST  *) 

(*  ALPHABETICALLY  SORT  THE  ENTITIES  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  ENTITY  KIND  CONSTANTS  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  DEFINED  TYPE  DECLARATIONS  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  ENTITY  DECLARATIONS  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  MAS  ENTITY  DECLARATIONS  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  KEYBLOCK  DECLARATIONS  *) 
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) 


(*  ELSE  *) 
(*  IF  RETURN  WAS  SELEGTED  THEN  *) 
(*  RETURN  TO  THE  REPORT  MENU  *) 
(*  ELSE  *) 
(*  IF  EXIT  WAS  SELECTED  THEN  *) 
(*  RETURN  TO  THE  MAIN  MENU  *) 
(*  ELSE  *) 
(*  DISPLAY  AN  ERROR  MESSAGE  FOR  AN  INVALID  OPTION  *) 
(*  END;  *) 
(*  *) 
(*  ^COMMENTS:  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 
(*  *) 
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(*  %INCLUDE  BSGTRSPR  *) 

(**) 

PROCEDURE  BSCTRSPR(VAR  IRC  :  RET_REC ; 

VAR  TRANS_STACK  :  TRANS PXR); 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  ^FUNCTION:  *) 

(*  THIS  ROUTINE  BEGINS  THE  PROCESSING  OF  THE  TRANSACTION  *) 

(*  STACK.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  REF  *) 

(*  CURRENT_LIST  I/O  POINTS  TO  THE  LIST  OF  KEYS  *) 

(*  CURRENTLY  IN  USE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

<*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  CALLS  SCPOPTR  TO  POP  THE  TRANSACTION  STACK.  *) 

(*  THEN  EACH  TRANSACTION  IS  PROCESSED  ACCORDING  TO  ITS  TYPE  *) 

(*  BY  CALLING  THE  APPROPRIATE  ROUTINE  TO  MODEL  THE  ENTITIES.  *) 

<*  *) 

(*  $ COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  CLRSTK  *) 

(**) 

PROCEDURE  CLRSTK(VAR  IRC  :  RET_REC ; 

VAR  TRANS_STACK  :  TRANSPTR); 

SUBPROGRAM; 

<**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  BATCH  INTERFACE  ROUTINE  THAT  CLEARS  THE  TRANSACTION  *) 

(*  PROCESSING  STACK.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  TRANSACTION  STACK  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INITIALIZE  VARIABLES  *) 

(*  WHILE  THE  STACK  IS  NOT  EMPTY,  POP  TRANSACTION  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  03/20/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  XINCLUDE  CLRSTK  *) 
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(*  %INCLUDE  CRARRAY  *) 

(**) 

PROCEDURE  CRARRAY (VAR  MESS  :  MESSAGE; 

VAR  LBND  :  CHAR8; 

VAR  HBND  :  CHAR8 ; 

VAR  ATYPE  :  ENTITYJTYPE; 

VAR  NEXT_0P  :  OPERATIONS; 

VAR  CONTEXT  :  T_CONTEXT ; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - - - - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  CREATE  ARRAY  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  LBND  0  THE  LOWER  BOUND  OF  THE  ARRAY  *) 

(*  HBND  0  THE  UPPER  BOUND  OF  THE  ARRAY  *) 

(*  ATYPE  0  THE  ARRAY  TYPE  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  CONTEXT  I  THE  CONTEXT  IN  WHICH  THE  DEFINED  TYPE  *) 

(*  IS  BEING  CREATED  *) 

<*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

<*  DISPLAY  THE  CREATE  ARRAY  PANEL  (CRARRAY)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  GATHERED  *) 
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(*  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PROCEDURE.  *) 


(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  *) 

(*  REVISED:  JANUARY  1988  C.  H.  MOHME  DBMA  *) 

(*  MODIFIED  TO  INCORPORATE  THE  STRUCTURE  DATA  TYPE  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  PANEL  OPTION  NUMBERS;  ADDED  LIST  AND  SET.  NOTE:  THE  *) 

(*  LIST  AND  SET  DATA  TYPES  ARE  IMPLEMENTED  IN  THE  SOFTWARE  AS  AN  *) 

(*  ARRAY.  A  FIELD  WAS  ADDED  TO  THE  ARRAY  ADB  TO  SPECIFY  WHETHER  *) 

(*  THE  ARRAY  IS  A  CONCEPTUAL  ARRAY,  LIST,  OR  SET.  *) 

(*  *) 

(*  REVISED:  07/02/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  CURSOR  POSITIONING.  *) 

(*  *) 

(*  ORIGINATED:  02/04/86  G.  A.  TUCKER  FRMI  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  CRARRAY  *) 
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(*  %INCLUDE  CRCLASS1 
(**) 

PROCEDURE 


CRCLASS1(VAR  MESS 

MESSAGE; 

VAR  NAME 

T_NAME; 

VAR  KNUM 

CHAR8; 

VAR  COMMENT 

CHAR150; 

VAR  NEXT_OP 

OPERATIONS 

VAR  RR 

RET_REC); 

(**) 
(* — 
(* 

(* 

<* 

(* 

(* 

(* 


SUBPROGRAM; 


-*) 

*) 

*) 

*) 

*) 

*) 

*) 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 


^FUNCTION: 

THIS  FUNCTION: 


DISPLAYS  THE  CREATE  CLASS1  PANEL 


^DESCRIPTION  OF  ARGUMENTS: 


(* 

NAME 

I/O 

DESCRIPTION 

*) 

(* 

==== 

=-= 

n 

ii 

ii 

ii 

ii 

ii 

ii 

ii 

n 

ii 

ii 

*) 

(* 

MESS 

I 

THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 

*) 

(* 

NAME 

0 

THE  CLASS  NAME 

*) 

(* 

KNUM 

0 

THE  CLASS  KIND  NUMBER 

*) 

(* 

(* 

NEXT_OP 

0 

ENUMERATED  TYPE  INDICATING  THE  NEXT 
OPERATION 

*) 

*) 

(* 

(* 

RR 

0 

INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 
IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 

*) 

*) 

$ COMMONS : 

NONE 

^ENVIRONMENT : 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

DDNAMES  USED  WITH  STANDARD  FILES: 

NONE 

^EXECUTION  PROCEDURE: 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

^PROCESSING  DESCRIPTION: 

DISPLAY  THE  CREATE  CLASS  PANEL  NUMBER  ONE  (CRCLASS1)  BY 
MAKING  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED 
INTO  AN  ENUMERATED  TYPE.  THIS  DATA  AS  WELL  AS  OTHER 
INFORMATION  GATHERED  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE 
CALLING  PROCEDURE. 

^COMMENTS : 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(* 

NONE 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

*) 
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(*  7.INCLUDE  CRCLASS2  *) 

(**) 

PROCEDURE  CRCLASS2(VAR  MESS  :  MESSAGE; 

VAR  KNUM  :  CHAR8 ; 

VAR  NEXT_0P  :  OPERATIONS; 

VAR  RR  :  RET_REC); 

SUBPROGRAM; 

<**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  CREATE  CLASS  PANEL  2  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  KNUM  0  THE  MEMBER  KIND  NUMBER  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *> 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

<*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISLAY  THE  CREATE  CLASS  PANEL  NUMBER  TWO  (CRCLASS2)  BY  *) 

(*  MAKING  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  *) 

(*  AN  ENUMERATED  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  *) 

(*  GATHERED  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PRO-  *) 

(*  CEDURE.  *) 

(*  *) 

(*  $ COMMENTS :  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  CRDEFTYP  *) 
(**) 


CRDEFTYP (VAR 

MESS 

MESSAGE; 

VAR 

NAME 

IDCHAR; 

VAR 

FTYPE 

ENTITY_TYPE 

VAR 

NEXT_OP 

OPERATIONS; 

VAR 

CONTEXT 

T_CONTEXT ; 

VAR 

RR 

RET_REC) ; 

SUBPROGRAM; 


(**) 

(*— 

(* 

(* 

(* 

(* 

(* 

(* 


-*) 

*) 

*) 

*) 

*) 

*) 

*) 


^FUNCTION: 

THIS  FUNCTION: 


DISPLAYS  THE  CREATE  DEFINED  TYPE  MENU 


^DESCRIPTION  OF  ARGUMENTS: 


(* 

(* 

(* 

NAME 

I/O 

DESCRIPTION 

*) 

*) 

*) 

MESS 

I 

THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 

(* 

NAME 

0 

THE  NAME  OF  THE  DEFINED  TYPE  ENTERED 

*) 

(* 

FTYPE 

0 

TYPES  INTEGER , STRING , REAL ... ETC . 

*) 

(* 

NEXT.OP 

0 

ENUMERATED  TYPE  INDICATING  THE  NEXT 

*) 

(* 

OPERATION 

*) 

(* 

CONTEXT 

I 

THE  CONTEXT  IN  WHICH  THE  DEFINED  TYPE 

*) 

(* 

IS  BEING  CREATED 

*) 

(* 

RR 

0 

INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 

*) 

(* 

IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 

*) 

(* 

*> 

(* 

$ COMMONS : 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

DDNAMES  USED 

WITH 

STANDARD  FILES: 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

*) 

<* 

*) 

<* 

^PROCESSING  DESCRIPTION 

« 

• 

*) 

(* 

DISPLAY  THE 

CREATE 

DEFINED  TYPE  PANEL  (CRDEFTYP)  BY  MAKING 

*) 

<* 

ISPLNK  CALLS 

.  THE 

OPTION  CHOSEN  IS  TRANSLATED  INTO  AN 

*) 

(* 

ENUMERATED  TYPE. 

THIS  DATA  AS  WELL  AS  OTHER  INFORMATION 

*) 

(* 

GATHERED  FROM  THE 

PANEL  IS  PASSED  BACK  TO  THE  CALLING  PRO- 

*) 

(* 

CEDURE. 

*) 

<* 

*) 
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(*  $ COMMENTS :  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  REVISED:  JANUARY  1988  C.  H.  MOHME  DBMA  *) 

(*  MODIFIED  TO  INCORPORATE  THE  STRUCTURE  DATA  TYPE.  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  PANEL  OPTION  NUMBERS;  ADDED  LIST  AND  SET.  NOTE:  THE  *) 

(*  LIST  AND  SET  DATA  TYPES  ARE  IMPLEMENTED  IN  THE  SOFTWARE  AS  AN  *) 

(*  ARRAY.  A  FIELD  WAS  ADDED  TO  THE  ARRAY  ADB  TO  SPECIFY  WHETHER  *) 

(*  THE  ARRAY  IS  A  CONCEPTUAL  ARRAY,  LIST,  OR  SET.  *) 

(*  *) 

(*  REVISED:  07/02/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  CURSOR  POSITIONING.  *) 

(*  *) 

(*  ORIGINATED:  02/04/86  G.  A.  TUCKER  FRMI  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  CRDEFTYP  *) 
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(*  %INCLUDE  CRENTITY  *) 
<**) 


CRENTITY(VAR  MESS 

MESSAGE; 

VAR  NAME 

T_NAME; 

VAR  KNUM 

CHARS; 

VAR  REFR 

CHAR8 ; 

VAR  COMMENT 

CHAR150; 

VAR  NEXT_OP 

OPERATIONS 

VAR  RR 

RET_REC) ; 

(**) 
(* — 
<* 

<* 

(* 

(* 

(* 

(* 


SUBPROGRAM; 


-*) 

*) 

*) 

*) 

*) 

*) 

*) 


^FUNCTION: 


THIS  PROCEDURE  : 

DISPLAYS  THE  CREATE  ENTITY  MENU 


^DESCRIPTION  OF  ARGUMENTS: 


C* 

(* 

(* 

NAME 

I/O 

DESCRIPTION 

*) 

*) 

*) 

MESS 

I 

THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 

(* 

NAME 

0 

THE  ENTITY  NAME 

*) 

(* 

KNUM 

0 

THE  ENTITY  KIND  NUMBER 

*) 

(* 

REFR 

0 

INDICATES  IF  AN  ENTITY  REFERENCES  A 

*) 

(* 

SUPERTYPE 

*) 

(* 

NEXT_OP 

0 

ENUMERATED  TYPE  INDICATING  THE  NEXT 

*) 

C* 

OPERATION 

*) 

(* 

RR 

0 

INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 

*) 

<* 

IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 

*) 

(* 

*) 

<* 

$ COMMONS : 

*) 

(* 

NONE 

*) 

<* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

*> 

(* 

HARDWARE  SYSTEM: 

IBM  360/370/4341/4381 

*) 

(* 

DDNAMES  USED 

WITH  STANDARD  FILES: 

*) 

<* 

NONE 

*> 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

SCHEMA  EXECUTIVE 

MENU  INTEF FACE  ROUTINE 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

DISPLAY  THE 

CREATE  ENTITY  PANEL  (CRENTITY)  BY  MAKING  ISPLNK 

*) 

<* 

CALLS.  THE 

OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED 

*) 

(* 

TYPE.  THIS 

DATA 

AS  WELL  AS  OTHER  INFORMATION  GATHERED  FROM 

*) 

(* 

THE  PANEL  IS 

PASSED  BACK  TO  THE  CALLING  PROCEDURE. 

*) 
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(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  REVISED:  09/28/87  C.  H.  MOHME  D3MA  *) 

(*  CHANGED  TO  INCORPORATE  THE  SUPERTYPE  DATA  TYPE.  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  PANEL  OPTION  NUMBERS.  *) 

(*  *) 

(*  REVISED:  07/02/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  CURSOR  POSITIONING.  *) 

(*  *) 

(*  ORIGINATED:  03/14/86  G.  A.  TUCKER  FRMI  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  ^INCLUDE  CRENTITY  *) 
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(*  ^INCLUDE  CRENUM  *) 

(**) 

PROCEDURE  CRENUM(VAR  MESS  :  MESSAGE; 

VAR  NAME  :  IDCHAR; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  THIS  FUNCTION: 

(*  DISPLAYS  THE  CREATE  ENUMERATION  MENU 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 


(* 

'* 

NAME 

I/O 

DESCRIPTION 

\ 

(* 

MESS 

I 

THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 

(* 

NAME 

0 

THE  NAME  OF  THE  ENUMERATION  FROM  PANEL 

(* 

NEXT.OP 

0 

ENUMERATED  TYPE  INDICATING  THE  NEXT 

(* 

OPERATION 

(* 

XRC 

0 

INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 

(* 

IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 

(* 

(*  ^COMMONS: 

(*  NONE 

(* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

<*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(*  DDNAMES  USED  WITH  STANDARD  FILES: 

(*  NONE 

(* 

(*  $EXECUTION  PROCEDURE: 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(*  DISPLAY  THE  CREATE  ENUMERATION  PANEL  (CRENUM)  BY  MAKING 

(*  ‘  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN 

(*  ENUMERATED  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION 

(*  GATHERED  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING 

(*  PROCEDURE. 

(* 

(*  $ COMMENTS: 

(*  NONE 

(* 

(*  ^CHANGE  CONTROL: 

(* 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  CRFIELD  *) 
(**) 


PROCEDURE  CRFIELD (VAR  MESS 

MESSAGE; 

VAR  NAME 

T_NAME; 

VAR  POS 

CHARS; 

(*  VAR  PUR? 

CHAR8 ;  *) 

VAR  REQD 

CHAR8; 

(*  VAR  DEPD 

CHAR8;  *) 

VAR  COM 

CHAR50; 

VAR  FTYPE 

ENTITY_TYPE ; 

VAR  FLDTYP 

T_FIELDTYPE ; 

VAR  NEXT_OP 

OPERATIONS; 

VAR  RR 

RET_REC) ; 

SUBPROGRAM; 


(**) 

(*-- 

(* 

(* 

^FUNCTION: 

(* 

THIS  PROCEDURE  : 

(* 

DISPLAYS  THE  CREATE  FIELD  PANEL 

(* 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

(* 

<* 

(* 

NAME 

I/O 

DESCRIPTION 

MESS 

I 

THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 

(* 

NAME 

0 

THE  NAME  OF  THE  FIELD 

(* 

POS 

0 

THE  POSITION  OF  THE  FIELD  IN  THE  ADB 

(* 

PURP 

0 

THE  PURPOSE  OF  THE  FIELD 

(* 

REQD 

0 

REQUIREDNESS,  OPTIONAL  OR  NOT,  OF  FIELD 

(* 

DEPD 

0 

DEPENDENCE  OF  THE  FIELD 

<* 

FTYPE 

0 

ENTITY  TYPE 

(* 

FLDTYPE 

0 

THE  FIELD  TYPE 

(* 

NEXT_OP 

0 

ENUMERATED  TYPE  INDICATING  THE  NEXT 

c* 

OPERATION 

(* 

RR 

0 

INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 

(* 

IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 

(* 

(* 

^COMMONS : 

(* 

NONE 

(* 

(* 

^ENVIRONMENT : 

(* 

LANGUAGE: 

IBM  PASCAL 

(* 

HARDWARE 

SYSTEM: 

IBM  360/370/4341/4381 

.*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  _  *) 

(*  DISPLAY  THE  CREATE  FIELD  PANEL  (CRFIELD)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  GATHERED  FROM  *) 

(*  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PROCEDURE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  REVISED:  JANUARY  1988  C.  H.  MOHME  DBMA  *) 

(*  MODIFIED  TO  INCORPORATE  THE  STRUCTURE  DATA  TYPE  *) 

(*  *) 

(*  REVISED:  09/28/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  TO  INCORPORATE  THE  SUPERTYPE  FIELD.  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  PANEL  OPTION  NUMBERS;  CHANGED  FIELD  ADB  DATA;  ADDED  *) 

(*  LIST  AND  SET.  NOTE:  THE  LIST  AND  SET  DATA  TYPES  ARE  IMPLE-  *) 

(*  MENTED  IN  THE  SOFTWARE  AS  AN  ARRAY.  A  FIELD  WAS  ADDED  TO  THE  *) 

(*  ARRAY  ADB  TO  SPECIFY  WHETHER  THE  ARRAY  IS  A  CONCEPTUAL  ARRAY,  *) 

(*  LIST,  OR  SET.  *) 

(*  *) 

(*  REVISED:  07/02/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  CURSOR  POSITIONING.  *) 

(*  *) 

(*  ORIGINATED:  03/14/86  G.  A.  TUCKER  FRMI  *) 

(*  *) 

(* - 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  CRFIELD  *) 
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(*  %INCLUDE  CRINTGR  *) 

(**) 

PROCEDURE  CRINTGR(VAR  MESS  :  MESSAGE; 

VAR  PREC  :  CHAR8 ; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  CREATE  INTEGER  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  PREC  0  THE  PRECISION  OF  THE  INTEGER  ENTERED  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

<*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  CREATE  INTEGER  PANEL  (CRINTGR)  BY  MAKING  *) 

(*  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  *) 

(*  ENUMERATED  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  *) 

(*  GATHERED  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  *) 

(*  PROCEDURE.  *) 

(*  *) 

(*  $ COMMENTS :  *) 

<*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 
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(*  *) 

(*  REVISED:  10/09/87  C.  H.  MOHME  DBMA  *) 

(*  ADDED  DEFAULT  PRECISION.  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  PANEL  OPTION  NUMBERS.  *) 

(*  *) 

(*  REVISED:  07/02/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  CURSOR  POSITIONING.  *) 

(*  *) 

(*  ORIGINATED:  04/08/86  G.  A.  TUCKER  FRMI  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  CRINTGR  *) 


3-231 


Cl  PS560240032U 
April  1990 


(*  %INCLUDE  CRLIST  *) 

(**) 

PROCEDURE  CRLIST(VAR  MESS  :  MESSAGE; 

VAR  MIN  :  CHAR8 ; 

VAR  MAX  :  CHAR8 ; 

VAR  ATYPE  :  ENTITYJTYPE; 
VAR  NEXT.OP  :  OPERATIONS; 
VAR  CONTEXT  :  T_CONTEXT ; 
VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 


(* - *) 

<*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  CREATE  LIST  PANEL  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  MIN  0  THE  MINIMUM  NUMBER  OF  OCCURRENCES  IN  THE  *) 

(*  LIST  *) 

(*  MAX  0  THE  MAXIMUM  NUMBER  OF  OCCURRENCES  IN  THE  *) 

(*  LIST  *) 

(*  ATYPE  0  THE  LIST  TYPE  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  CONTEXT  I  THE  CONTEXT  IN  WHICH  THE  DEFINED  TYPE  *) 

(*  •  IS  BEING  CREATED  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  CREATE  LIST  PANEL  (CRLIST)  BY  MAKING  ISPLINK  *) 
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(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 


(*  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  GATHERED  *) 

(*  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PROCEDURE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  | CHANGE  CONTROL:  *) 

(*  *) 
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(*  ^INCLUDE  CRPNTR  *) 

(**) 

PROCEDURE  CRPNTR(VAR  MESS  :  MESSAGE; 

VAR  KNUM  :  CHAR8; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  CREATE  POINTER  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  KNUM  0  THE  MEMBER  KIND  NUMBER  OF  THE  POINTER  *) 

(*  INTO  AN  INTEGER  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  CREATE  POINTER  PANEL  (CRPNTR)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  GATHERED  FROM  *) 

(*  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PROCEDURE.  *) 

(*  *) 

(*  $ COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 
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(*  %INCLUDE  CRREAL  *) 

(**) 

PROCEDURE  CRREAL (VAR  MESS  :  MESSAGE; 

VAR  SIZE  :  CHAR8; 

VAR  NEXT_0P  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  ^FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  CREATE  REAL  PANEL  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  SIZE  0  THE  PRECISION  OF  THE  REAL  ENTERED  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  CREATE  REAL  PANEL  (CRREAL)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  GATHERED  FROM  *) 

(*  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PROCEDURE.  *) 

(*  *) 

(*  $ COMMENTS:  *) 

(*  NONE  *) 

<*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  REVISED:  10/09/87  C.  H.  MOHME  DBMA  *) 

(*  ADDED  DEFAULT  PRECISION.  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  PANEL  OPTION  NUMBERS.  *) 

(*  *) 

(*  REVISED:  07/02/86  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  CURSOR  POSITIONING.  *) 

(*  *) 

(*  ORIGINATED:  04/08/86  G.  A.  TUCKER  FRMI  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  CRREAL*) 
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(*  %INCLUDE  CRSET  *) 

(**) 

PROCEDURE  CRSET(VAR  MESS  :  MESSAGE; 

VAR  MIN  :  CHAR8 ; 

VAR  MAX  :  CHAR8 ; 

VAR  ATYPE  :  ENTITY_TYPE; 
VAR  NEXT_0P  :  OPERATIONS; 
VAR  CONTlxT  :  T_CONTEXT; 
VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  CREATE  SET  PANEL  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  MIN  0  THE  MINIMUM  NUMBER  OF  OCCURRENCES  IN  THE  *) 

(*  SET  *) 

(*  MAX  0  THE  MAXIMUM  NUMBER  OF  OCCURRENCES  IN  THE  *) 

(*  SET  *) 

(*  ATYPE  0  THE  SET  TYPE  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  CONTEXT  I  THE  CONTEXT  IN  WHICH  THE  SET  IS  BEING  *) 

(*  CREATED  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  CREATE  SET  PANEL  (CRSET)  BY  MAKING  ISPLINK  *) 
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(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 


(*  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  GATHERED  *) 

(*  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PROCEDURE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  •  *) 

(*  *) 
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(*  %INCLUDE  CRSTRING  *) 

(**) 

PROCEDURE  CRSTRING(VAR  MESS  :  MESSAGE; 

VAR  SLEN  :  CHAR8 ; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  CREATE  STRING  PANEL  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  SLEN  0  THE  LENGTH  OF  THE  STRING  ENTERED  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION.  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  CREATE  STRING  PANEL  (CRSTRING)  BY  MAKING  ISPLNK  *) 

(*  .  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  GATHERED  FROM  *) 

(*  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PROCEDURE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  REVISED:  10/09/87  C.  H.  MOHME  DBMA  *) 

(*  ADDED  DEFAULT  STRING  LENGTH.  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  PANEL  OPTION  NUMBERS.  *) 

(*  *) 

(*  REVISED:  07/02/87  C.  H.  MOHME  DBMA  *) 

-(*  CHANGED  CURSOR  POSITIONING.  *) 

(*  *) 

(*  ORIGINATED:  04/08/86  G.  A.  TUCKER  FRMI  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  CRSTRING  *) 
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(*  %INCLUDE  CRSUBSCM  *) 

(**) 

PROCEDURE  CRSUBSCM(VAR  MESS  :  MESSAGE; 

VAR  NAME  :  T_NAME; 

VAR  COMMENT  :  CHAR150; 

VAR  KNUM  :  CHAR8 ; 

VAR  NEXT_0P  :  OPERATIONS; 

VAR  RR  :  RET.REC); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  CREATE  SUBSCHEMA  PANEL  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NAME  0  THE  SUBSCHEMA  NAME  *) 

(*  KNUM  0  THE  SUBSCHEMA  MEMBER  KIND  NUMBER  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

<*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *> 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  CREATE  SUBSCHEMA  PANEL  (CRSUBSCM)  BY  MAKING  *) 

(*  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  *) 

(*  ENUMERATED  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  *) 

(*  GATHERED  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PRO-  *) 

(*  CEDURE.  *) 

<*  *) 

(*  $ COMMENTS :  *) 

(*  NONE  *) 

<*  *> 

(*  $ CHANGE  CONTROL:  *) 
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(*  %INCLUDE  CRSUPTYP  *) 

(**) 

PROCEDURE  CRSUPTYP(VAR  MESS 


SUBPROGRAM; 

(**) 


VAR  NAME 
VAR  REFR 
VAR  CREATE_ONLY 
VAR  NEXT_OP 
VAR  RR 


MESSAGE; 

T_NAME; 

CHAR8 ; 

BOOLEAN; 

OPERATIONS; 

RET.REC); 


(*- 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

<* 

(* 

<* 

(* 


^FUNCTION: 

THIS  PROCEDURE: 

DISPLAYS  EITHER  THE  CREATE/REFERENCE  SUPERTYPE  MENU 
OR  THE  CREATE  SUPERTYPE  MENU 


^DESCRIPTION  OF  ARGUMENTS: 

NAME  I/O  DESCRIPTION 


MESS 

NAME 

REFR 

CREATE_ONLY 

NEXT_OP 

RR 


I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 
0  THE  ENTITY  NAME 

0  INDICATES  IF  THE  SUPERTYPE  REFERENCES 
ANOTHER  SUPERTYPE 
I  INDICATES  I 

0  ENUMERATED  TYPE  INDICATING  THE  NEXT 
OPERATION 

0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 
IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 


$ COMMONS : 
NONE 


^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

DDNAMES  USED  WITH  STANDARD  FILES: 

NONE 


^EXECUTION  PROCEDURE: 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 


^PROCESSING  DESCRIPTION: 

DISPLAY  THE  CREATE  SUPERTYPE  PANEL  (CRSUPTYPE)  BY  MAKING 
ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN 
ENUMERATED  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 
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(*  GATHERED  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  *) 
(*  PROCEDURE.  *) 
(*  *) 
(*  $ COMMENTS :  *) 
(*  NONE  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 
(*  *) 
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(*  %INCLUDE  CRURUL.  *) 

(**) 

PROCEDURE  CRURUL (CONST  ENTITY_TYPE : ORD_KIND ; VAR  GROUP :T_GROUP_ARRAY; 


VAR  NUM_GROUP : LISTPSTN ;  VAR  MIN_CNST : LI STPSTN) {EXTERNAL; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  CREATES  THE  USER'S  RULES.  RULES  OF  CONNECTIVITY  USED  TO  *) 

(*  DETERMINE  DELETABILITY  OF  ENTITIES.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  ENTITY_TYPE  I  ENTITY  KIND  VALUE  WHICH  WILL  HAVE  THE  *) 

(*  DELETE  RULE  *) 

(*  GROUP  0  ARRAY  THAT  WILL  BE  FILLED  WITH  THE  RULES  *) 

(*  AND  NUMBER  OF  CONSTITUENTS  OF  EACH  *) 

(*  DIFFERENT  RELATIONSHIP  THAT  THIS  ENTITY  *) 

(*  KIND  CAN  HAVE  WITH  ITS  CONSTITUENTS  *) 

(*  NUM_GROUP  0  NUMBER  OF  DIFFERENT  RELATIONSHIPS  THIS  *) 

(*  ENTITY  CAN  HAVE  WITH  ITS  CONSTITUENTS  *) 

(*  MIN_CNST  0  MINIMUM  NUMBER  OF  CONSTITUENTS  THAT  THIS  *) 

(*  ENTITY  CAN  HAVE  WHEN  IT  HAS  A  GROUP  OF  *) 

(*  CONSTITUENTS  THAT  ARE  "SECONDARY”  *) 

(*  RC  0  EXTERNAL  RETURN  CODE  *) 

(*  =  0  OK  RETURN  CODE  *) 

(*  >  0  CRITICAL  ERROR  *) 

(*  <0  WARNING  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4331  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  MODEL  ACCESS  SOFTWARE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  ??????ARE  SET  TO  INDICATE  IF  THE  RELATIONSHIP  BETWEEN  THE  *) 

(*  USER  AND  ITS  CONSTITUTES  IS  DEPENDENT  OR  INDEPENDENT  AND  *) 

(*  STRONG  OR  WEAK.  *) 

(*  DEFAULT  RULE  IS  DEPENDENT/STRONG.  *) 

(*  *) 

(*  $ COMMENTS :  *) 

<*  *) 
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(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  REVISED:  09/28/87  C.  H.  MOHME  DBMA  *) 

(*  TO  INCORPORATE  SUPERTYPE  DATA  TYPE  *) 

(*  *) 

(*  REVISED:  04/09/87  C.  H.  MOHME  DBMA  *) 

(*  TO  INCORPORATE  LIST  DATA  TYPE  *) 

(*  *) 

(*  REVISED:  09/29/86  L.  J.  BEHAN  DBMA  *) 

(*  ENTERED  THE  NEW  RULES  FOR  THE  SCHEMA  EXECUTIVE  ENTITIES  *) 

(*  *) 

(*  REVISED:  06/19/86  B.  A.  ULMER  FRMI  *) 

(*  REDO  LOGIC  OF  HOW  CRURUL  WORKS  BASED  ON  THE  NEW  DELETE  RULES  *) 

(*  *) 

(*  REVISED:  09/  /85  B.  A.  ULMER  FRMI  *) 

(*  ADD  ENTITY  KINDS  SO  AS  TO  TEST  THE  NEW  DELETE  RULES  (2070,  *) 

(*  2080,  2090)  *) 

(*  *) 

(*  REVISED:  09/  /85  B.  A.  ULMER  FRMI  *) 

(*  ADD  PARAMETERS  TO  HANDLE  THE  TWO  NEW  DELETE  RULES  *) 

(*  *) 

(*  REVISED:  09/18/84  D.  J.  KERCHNER  FRMI  *) 

(*  ADDED  I/S  RULE  FOR  THE  PICK  ENTITY  *) 

(*  *) 

(*  ORIGINATED:  MM/DD/YY  CCWW  I.  M.  THEORIGINATOR  GROUP_ID  *) 

(*  *) 

(* - *) 

%PAGE  *) 

(* - 

(*  DATA  STRUCTURES /MAJOR  VARIABLES:  *) 

(* - *) 

(*  *) 

<*END - - *) 

(**) 

(*  END  %INCLUDE  CRURUL  *) 
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(*  %INCLUDE  CSARYWRT  *) 

(**) 

PROCEDURE  CSARYWRT(VAR  IRC  :  RET_REC; 

VAR  ARRAY_KEY  :  ENTKEY; 

VAR  CSRFILE  :  TEXT; 

VAR  PAGE_NUMBER  :  INTEGER; 

VAR  LINE_COUNT  :  INTEGER; 

VAR  INDENT  :  INTEGER; 

VAR  PAGEJTYPE  :  PAGES); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  WRITES  OUT  AN  ARRAY  DEFINITION  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  ARRAYJCEY  I  ARRAY  KEY  *) 

(*  CSRFILE  I/O  OUTPUT  FILE  *) 

(*  PAGE_NUMBER  I/O  CURRENT  PAGE  NUMBER  *) 

(*  LINE_COUNT  I/O  CURRENT  LINE  COUNT  *) 

(*  INDENT  I/O  NUMBER  OF  SPACES  TO  INDENT  *) 

(*  PAGE_TYPE  I/O  TYPE  OF  REPORT  PAGE  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

<*  *) 

(*  CREATE  A  NEW  PAGE  WITH  HEADING,  IF  NECESSARY.  *) 

(*  GET  THE  ARRAY'S  ADB.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  ARRAY  BOUNDS.  *) 

(*  SET  THE  LIST  OF  CONSTITUENTS  OF  THE  ARRAY  TO  BE  READ  IN  THE  *) 

(*  FORWARD  DIRECTION.  *) 

(«*  READ  THE  ARRAY  CONSTITUENT  FROM  THE  LIST.  *) 

GET  THE  ARRAY  CONSTITUENT'S  ADB.  *) 
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(* 

CASE  CONSTITUENT 

LADB.ENTJCIND  OF 

*) 

(* 

INTEGER 

WRITE 

OUT 

INTEGER  DEFINITION 

*) 

(* 

REAL 

WRITE 

OUT 

REAL  DEFINITION 

*) 

(* 

STRING 

WRITE 

OUT 

STRING  DEFINITION 

*) 

(* 

LOGICAL 

WRITE 

OUT 

LOGICAL  DEFINITION 

*) 

(* 

ARRAY 

WRITE 

OUT 

ARRAY  DEFINITION 

*) 

(* 

DEFINED  TYPE 

WRITE 

OUT 

DEFINED  TYPE  DEFINITION 

*) 

(* 

POINTER 

WRITE 

OUT 

POINTER  DEFINITION 

*) 

(* 

*) 

(* 

$ COMMENTS : 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL 

*) 

(* 

*) 
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(*  %INCLUDE  CSCLSHDG  *) 

(**) 

PROCEDURE  CSCLSHDG(VAR  CSRFILE 

VAR  HEADING 
VAR  PAGE_NUMBER 
VAR  LINE  COUNT 


TEXT; 

HEADING_TYPE; 

INTEGER; 

INTEGER); 


SUBPROGRAM; 

(**) 


\  <*-- 

-*) 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

THIS  ROUTINE  WRITES  OUT  A  CLASS  HEADING  ON  A  NEW  PAGE. 

*) 

(* 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME  I/O  DESCRIPTION 

*) 

(* 

ii 

ii 

n 

ii 

ii 

n 

it 

ii 

n 

ii 

n 

ii 

ii 

ii 

ii 

n 

n 

ii 

*) 

(* 

CSRFILE  I/O  OUTPUT  FILE 

*) 

(* 

HEADING  I  DEFINITION  OR  INDEX  HEADING 

*) 

(* 

PAGE_NUMBER  I/O  CURRENT  PAGE  NUMBER 

*) 

(* 

LINE_COUNT  0  LINE  COUNT  ON  THE  CURRENT  PAGE 

*) 

(* 

*) 

(* 

$ COMMONS : 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

<* 

*) 

(* 

CREATE  A  NEW  PAGE. 

*) 

(* 

WRITE  OUT  TO  THE  FILE  THE  APPROPRIATE  CLASS  HEADING  (DEFINITION 

*) 

(* 

OR  INDEX). 

*) 

(* 

*) 

(* 

$ COMMENTS: 

*) 

<* 

*) 

(* 

^CHANGE  CONTROL: 

*) 

(* 

*) 

T 
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(*  %INCLUDE 
(**) 

PROCEDURE 


CSCLSWRT  *) 

CSCLSWRT(VAR  IRC 

VAR  CLASS_LIST 
VAR  CSRFILE 
VAR  PAGE_NUMBER 
VAR  CURRENT_PAGE 


RET_REC; 
LISTKEY; 
TEXT; 
INTEGER; 
PAGE_PTR) ; 


(**) 

(*— 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

c* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


SUBPROGRAM; 


^FUNCTION: 

THIS  ROUTINE  WRITES  OUT  CLASS  DEFINITIONS  TO  A  FILE 

^DESCRIPTION  OF  ARGUMENTS: 

NAME 

IRC 

CLASS_LIST 
CSRFILE 
PAGE_NUMBER 
CURRENT_PAGE 


$ COMMONS : 

NONE 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT 
^PROCESSING  DESCRIPTION: 

SET  THE  LIST  OF  CLASSES  TO  BE  READ  IN  THE  FORWARD  DIRECTION. 
COUNT  THE  NUMBER  OF  CLASSES  IN  THE  LIST. 

FOR  X  =  1  TO  THE  NUMBER  OF  CLASSES  IN  THE  LIST 

WRITE  OUT  TO  THE  FILE  THE  CLASS  HEADING  ON  A  NEW  PAGE. 
UPDATE  THE  PAGE  RECORD  CHAIN. 

READ  A  CLASS  FROM  THE  LIST  OF  CLASSES. 

GET  THE  CLASS’  ADB. 

WRITE  OUT  TO  THE  FILE  THE  CLASS  NAME  AND  NUMBER. 

SET  THE  LIST  OF  CONSTITUENTS  OF  THE  CLASS  TO  BE  READ  IN  THE 
FORWARD  DIRECTION. 


I/O  DESCRIPTION 

0  INTERNAL  RETURN  CODE 

I  ALPHABETIZED  LIST  OF  CLASSES 

I/O  THE  OUTPUT  FILE 
I/O  THE  CURRENT  PAGE  NUMBER 
I/O  POINTS  TO  THE  CURRENT  PAGE  RECORD  IN 
THE  CHAIN 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 


1 
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(*  COUNT  THE  NUMBER  OF  CONSTITUENTS  IN  THE  LIST.  *) 

(*  FOR  Y  =  1  TO  THE  NUMBER  OF  CLASS  CONSTITUENTS  *) 

(*  READ  A  CONSTITUENT  FROM  THE  LIST  OF  CONSTITUENTS.  *) 

(*  GET  THE  CONSTITUENT'S  ADB.  *) 

(*  CREATE  A  NEW  PAGE,  IF  NECESSARY.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  CONSTITUENT  (CLASS  OR  ENTITY)  *) 

(*  INCREMENT  THE  LINE  COUNTER.  *) 

(*  WRITE  OUT  TO  THE  FILE  'END;'.  *) 

(*  *) 

(*  $ COMMENTS :  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  CSDEFHDG  *) 

(**) 

PROCEDURE  CSDEFHDG(VAR  CSRFILE 

VAR  PAGE_NUMBER 
VAR  LINE_COUNT 


TEXT; 
INTEGER; 
INTEGER) ; 


SUBPROGRAM; 

(**) 

(*-- 

— 

— 

— *) 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

THIS  ROUTINE  WRITES  OUT  A  DEFINED  TYPE  HEADING  ON  A  NEW 

*) 

(* 

PAGE. 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

<* 

(  * 

NAME  I/O  DESCRIPTION 

*) 

(* 

CSRFILE  I/O  OUTPUT  FILE 

*) 

(* 

PAGE_NUMBER  I/O  CURRENT  PAGE  NUMBER 

*) 

(* 

LINE_COUNT  0  LINE  COUNT  ON  THE  CURRENT 

PAGE 

*) 

<* 

*) 

(* 

^COMMONS : 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA 

REPORT 

*) 

(* 

*) 

<* 

^PROCESSING  DESCRIPTION: 

*) 

<* 

*) 

(* 

CREATE  A  NEW  PAGE. 

*> 

(* 

WRITE  OUT  TO  THE  FILE  THE  DEFINED  TYPE  DEFINITION 

HEADING. 

*) 

(* 

INCREMENT  THE  LINE  COUNTER. 

*) 

(* 

*) 

(* 

$ COMMENTS: 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

*) 
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(*  %INCLUDE  CSDEFWRT  *) 

(**) 

PROCEDURE  CSDEFWRT (VAR  IRC 

VAR  DEFINED_TYPE_KEY 
VAR  CSRFILE 
VAR  LINE  COUNT 


RET_REC  5 
ENTKEY; 
TEXT; 
INTEGER); 


SUBPROGRAM; 


(**) 

(*__ 

— 

— 

- *) 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

THIS  ROUTINE  WRITES  OUT  A  DEFINED  TYPE  NAME 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME 

I/O  DESCRIPTION 

*) 
*  \ 

(* 

IRC 

0  INTERNAL  RETURN  CODE 

*) 

(* 

DEFINED  TYPE  KEY 

I  DEFINED  TYPE  KEY 

*) 

(* 

CSRFILE 

I/O  THE  OUTPUT  FILE 

*) 

(* 

LINE_COUNT 

I/O  CURRENT  LINE  COUNT 

*) 

(* 

*) 

(* 

^COMMONS : 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM 

PASCAL 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

*) 

(* 

GET  THE  DEFINED  TYPE'S  ADB. 

*) 

(* 

WRITE  OUT  TO  THE  FILE  THE  DEFINED  TYPE  NAME. 

*) 

(* 

INCREMENT  THE  LINE 

COUNTER. 

*) 

(* 

*> 

(* 

^COMMENTS : 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

*) 
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(*  %INCLUDE  CSENMWRT  *) 

(**) 

PROCEDURE  CSENMWRT (VAR  IRC 

VAR  ENUMERATIONKEY 
VAR  CSRFILE 
VAR  PAGE_NUMBER 
VAR  LINE_COUNT 
VAR  PAGE  TYPE 


RET_REC ; 

ENTKEY; 

TEXT; 

INTEGER; 

INTEGER; 

PAGES); 


(**) 

(*— 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 


SUBPROGRAM; 


^FUNCTION: 

THIS  ROUTINE  WRITES  OUT  AN  ENUMERATION  DEFINITION 
^DESCRIPTION  OF  ARGUMENTS: 


NAME 

I/O 

DESCRIPTION 

IRC 

0 

INTERNAL  RETURN  CODE 

ENUMERATIONJCEY 

I 

ENUMERATION  KEY 

CSRFILE 

I/O 

THE  OUTPUT  FILE 

PAGE_NUMBER 

I/O 

CURRENT  PAGE  NUMBER 

LINE_COUNT 

I/O 

CURRENT  LINE  COUNT 

PAGE_TYPE 

I/O 

TYPE  OF  REPORT  PAGE 

$ COMMONS : 
NONE 


^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

$ EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT 

^PROCESSING  DESCRIPTION: 

GET  THE  ENUMERATION'S  ADB. 

WRITE  OUT  TO  THE  FILE  'ENUMERATION  OF  ( ' . 

INCREMENT  THE  LINE  COUNTER. 

SET  THE  LIST  OF  CONSTITUENTS  OF  THE  ENUMERATION  TO  BE  READ  IN 
THE  FORWARD  DIRECTION. 

COUNT  THE  NUMBER  OF  CONSTITUENTS  IN  THE  LIST. 

FOR  Y  =  1  TO  THE  NUMBER  OF  CONSTITUENTS 

READ  A  CONSTITUENT  FROM  THE  LIST  OF  CONSTITUENTS. 

GET  THE  CONSTITUENT'S  ADB. 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*> 

*) 

*) 

*) 

*> 

*) 

*) 

*) 
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(*  CREATE  A  NEW  PAGE,  IF  NECESSARY.  *) 
(*  WRITE  OUT  TO  THE  FILE  THE  CONSTITUENT.  *) 
(*  INCREMENT  THE  LINE  COUNTER.  *) 
(*  WRITE  OUT  TO  THE  FILE  *) 
(*  *) 
(*  ^COMMENTS:  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 
(*  *) 
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(*  %INCLUDE  CSENTHDG  *) 

(**) 

PROCEDURE  CSENTHDG(VAR  CSRFILE 

VAR  HEADING 
VAR  PAGE_NUMBER 
VAR  LINE  COUNT 


TEXT} 

HEADING_TYPE; 
INTEGER; 
INTEGER) ; 


SUBPROGRAM} 

(**) 

(* - - - - - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  WRITES  OUT  AN  ENTITY  HEADING  ON  A  NEW  PAGE. 

(* 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 


(* 

(* 

(* 

NAME 

I/O 

DESCRIPTION 

CSRFILE 

I/O 

OUTPUT  FILE 

(* 

HEADING 

I 

DEFINITION  OR  INDEX  HEADING 

(* 

PAGEJNUMBER 

I/O 

CURRENT  PAGE  NUMBER 

(* 

LINE_COUNT 

0 

LINE  COUNT  ON  THE  CURRENT  PAGE 

(* 

(* 

$ COMMONS : 

(* 

NONE 

(* 

(* 

^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(* 

(*  CREATE  A  NEW  PAGE. 

(*  WRITE  OUT  TO  THE  FILE  THE  APPROPRIATE  ENTITY  HEADING  (DEFINITION 
(*  OR  INDEX). 

(*  INCREMENT  THE  LINE  COUNTER. 

(* 

(*  ^COMMENTS: 

(* 

(*  $ CHANGE  CONTROL: 

(* 


.*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  CSENTWRT  *) 

(**) 

PROCEDURE  CSENTWRT (VAR  IRC  :  RET_REC ; 

VAR  ENTITY_LIST  :  LISTKEY; 

VAR  CSRFILE  :  TEXT; 

VAR  PAGE_NUMBER  :  INTEGER; 

VAR  CURRENT_PAGE  :  PAGE_PTR) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $  FUNCTION:.  *) 

(*  THIS  ROUTINE  WRITES  OUT  ENTITY  DEFINITIONS  TO  A  FILE  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  ENTITYJLIST  I  ALPHABETIZED  LIST  OF  ENTITIES  *) 

(*  CSRFILE  I/O  THE  OUTPUT  FILE  *) 

(*  PAGE_NUMBER  I/O  THE  CURRENT  PAGE  NUMBER  *) 

(*  CURRENT_PAGE  I/O  POINTS  TO  THE  CURRENT  PAGE  RECORD  IN  *) 

(*  THE  CHAIN,  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

<*  *) 

(*  ^ENVIRONMENT:  *) 

<*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT  *) 

<*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  SET  THE  LIST  OF  ENTITIES  TO  BE  READ  IN  THE  FORWARD  DIRECTION.  *) 

(*  -COUNT  THE  NUMBER  OF  ENTITIES  IN  THE  LIST.  *) 

(*  FOR  X  =  1  TO  THE  NUMBER  OF  ENTITIES  IN  THE  LIST  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  ENTITY  HEADING.  *) 

(*  UPDATE  THE  PAGE  RECORD  CHAIN.  *) 

(*  READ  AN  ENTITY  FROM  THE  LIST  OF  ENTITIES.  *) 

(*  GET  THE  ENTITY'S  ADB,  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  ENTITY  NAME  AND  NUMBER.  *) 

(*  SET  THE  LIST  OF  CONSTITUENTS  OF  THE  ENTITY  TO  BE  READ  IN  THE  *) 

(*  FORWARD  DIRECTION.  *) 
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(*  COUNT  THE  NUMBER  OF  CONSTITUENTS  IN  THE  LIST.  *) 

(*  FOR  Y  =  1  TO  THE  NUMBER  OF  CONSTITUENTS  IN  THE  LIST  *) 

(*  READ  A  CONSTITUENT  FROM  THE  LIST.  *) 

(*  GET  THE  CONSTITUENT'S  ADB.  *) 

(*  CREATE  A  NEW  PAGE,  IF  NECESSARY.  *) 

(*  WRITE  OUT  TO  THE  FILE  A  FIELD  NAME.  *) 

(*  SET  THE  TYPE  OF  FIELD  TO  BE  READ  IN  THE  FORWARD  DIRECTION.  *) 

(*  GET  THE  TYPE'S  KEY.  *) 

(*  GET  THE  TYPE'S  ADB.  *) 

(*  CASE  TYPE_ADB . ENT_KIND  OF  *) 

(*  INTEGER  :  WRITE  OUT  THE  INTEGER  DEFINITION  *) 

(*  REAL  :  WRITE  OUT  THE  REAL  DEFINITION  *) 

(*  STRING  :  WRITE  OUT  THE  STRING  DEFINITION  *) 

(*  LOGICAL  :  WRITE  OUT  THE  LOGICAL  DEFINITION  *) 

(*  ARRAY  :  WRITE  OUT  THE  ARRAY  DEFINITION  *) 

(*  DEFINED  TYPE  :  WRITE  OUT  THE  DEFINED  TYPE  DEFINITION  *) 

(*  POINTER  :  WRITE  OUT  THE  POINTER  DEFINITION  *) 

(*  WRITE  OUT  TO  THE  FILE  'END;'.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  REVISED:  03/30/88  C.  H.  MOHME  DBMA  *) 

(*  INCORPORATED  THE  FIELD  POSITION  NUMBER.  *) 

(*  *) 

(*  REVISED:  09/28/87  C.  H.  MOHME  DBMA  *) 

(*  INCORPORATED  THE  SUPERTYPE  DATA  TYPE.  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  INCORPORATED  OPTIONAL  FIELD  CHARACTERISTIC  IN  THE  CONCEPTUAL  *) 

(*  SCHEMA  REPORT.  *) 

(*  *) 

(*  REVISED:  06/24/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  TO  PUT  INTO  BATCH  INPUT  FORMAT.  *) 

(*  *) 

(*  ORIGINATED:  10/28/86  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  /.INCLUDE  CSENTWRT  *) 
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(*  %INCLUDE  CSGBLHDG  *) 

(**) 

PROCEDURE  CSGBLHDG(VAR  CSRFILE 

VAR  PAGE  NUMBER 


VAR  LINE  COUNT 


TEXT; 

INTEGER; 

INTEGER); 


SUBPROGRAM; 

(**) 

(* - *) 

<*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  WRITES  OUT  A  GLOBAL  FIELD  HEADING  ON  A  NEW  *) 

(*  PAGE.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  CSRFILE  I/O  OUTPUT  FILE  *) 

(*  PAGE_NUMBER  I/O  CURRENT  PAGE  NUMBER  *) 

(*  LINE_COUNT  0  LINE  COUNT  ON  THE  CURRENT  PAGE  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

<*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  CREATE  A  NEW  PAGE.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  GLOBAL  FIELD  DEFINITION  HEADING.  *) 

(*  INCREMENT  THE  LINE  COUNTER.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE 
(**) 

PROCEDURE 


CSGBLWRT  *) 

CSGBLWRT(VAR  IRC 

VAR  GLOBAL_FIELD_LIST 
VAR  CSRFILE 
VAR  PAGE  NUMBER 


RET_REC; 
LISTKEY; 
TEXT; 
INTEGER) ; 


(**) 

(*- 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

<* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


SUBPROGRAM; 


-*) 


*) 

$ FUNCTION:  *) 

THIS  ROUTINE  WRITES  OUT  GLOBAL  FIELD  DEFINITIONS  TO  A  FILE  *) 

*) 

^DESCRIPTION  OF  ARGUMENTS:  *) 

NAME  I/O  DESCRIPTION  *) 

IRC  0  INTERNAL  RETURN  CODE  *) 

GLOBAL_FIELD_LIST  I  LIST  OF  GLOBAL  FIELDS  *) 

CSRFILE  I/O  THE  OUTPUT  FILE  *) 

PAGE_NUMBER  I/O  THE  CURRENT  PAGE  NUMBER  *) 

PAGEJiARK  I/O  ARRAY  OF  BOOLEAN:  TRUE  IF  PAGE  MARKS  *) 

THE  BEGINNING  OF  A  NEW  ENTITY,  FALSE  *) 

OTHERWISE.  *) 

*) 

$ COMMONS:  *) 

NONE  *) 

*) 

^ENVIRONMENT :  *) 

LANGUAGE:  IBM  PASCAL  *) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

*) 

^EXECUTION  PROCEDURE:  *) 

INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT  *) 

*) 

^PROCESSING  DESCRIPTION:  *) 

*) 

SET  THE  LIST  OF  GLOBAL  FIELDS  TO  BE  READ  IN  THE  FORWARD  *) 

DIRECTION.  *) 

COUNT  THE  NUMBER  OF  GLOBAL  FIELDS  IN  THE  LIST.  *) 

CREATE  A  LIST  FOR  THE  ALPHABETIZED  GLOBAL  FIELDS.  *) 

FOR  X  =  1  TO  THE  NUMBER  OF  GLOBAL  FIELDS  IN  THE  LIST  *) 

READ  A  GLOBAL  FIELD  FROM  THE  LIST  OF  GLOBAL  FIELDS.  *) 

SET  THE  CONSTITUENT  OF  THE  GLOBAL  FIELD  TO  BE  READ  IN  THE  *) 

FORWARD  DIRECTION.  *) 


READ  A  FIELD  KEY  FROM  THE  CONSTITUENT  LIST  OF  THE  GLOBAL  FIELD.*) 
ATTACH  THE  FIELD  KEY  TO  THE  LIST  FOR  THE  ALPHABETIZED  GLOBAL  *) 
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(* 

(* 

(* 

C* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


FIELDS.  *) 

SORT  THE  LIST  OF  GLOBAL  FIELDS  INTO  ALPHABETICAL  ORDER.  *) 

SET  THE  LIST  OF  GLOBAL  FIELDS  TO  BE  READ  IN  THE  FORWARD  *) 

DIRECTION.  *) 

WRITE  OUT  TO  THE  FILE  THE  GLOBAL  FIELD  DEFINITION  HEADING.  *) 

FOR  X  =  1  TO  THE  NUMBER  OF  GLOBAL  FIELDS  *) 

READ  A  GLOBAL  FIELD  FROM  THE  LIST  OF  GLOBAL  FIELDS.  *) 

GET  THE  FIELD'S  ADB  (THE  GLOBAL  FIELD'S  CONSTITUENT).  *) 

CREATE  A  NEW  PAGE,  IF  NECESSARY.  *) 

WRITE  OUT  TO  THE  FILE  THE  GLOBAL  FIELD  NAME.  *) 

SET  THE  TYPE  OF  THE  FIELD  TO  BE  READ  IN  THE  FORWARD  DIRECTION.  *) 

GET  THE  TYPE  KEY.  *) 

GET  THE  TYPE'S  ADB.  *) 

CASE  TYPE_ADB . ENT_KIND  OF  *) 

INTEGER  :  WRITE  OUT  THE  INTEGER  DEFINITION  *) 

REAL  :  WRITE  OUT  THE  REAL  DEFINITION  *) 

STRING  :  WRITE  OUT  THE  STRING  DEFINITION  *) 

LOGICAL  :  WRITE  OUT  THE  LOGICAL  DEFINITION  *) 

ARRAY  :  WRITE  OUT  THE  ARRAY  DEFINITION  *) 

DEFINED  TYPE  :  WRITE  OUT  THE  DEFINED  TYPE  DEFINITION  *) 

POINTER  :  WRITE  OUT  THE  POINTER  DEFINITION  *) 

WRITE  OUT  TO  THE  FILE  A  BLANK  LINE.  *) 

^COMMENTS:  *j 

$ CHANGE  CONTROL:  *) 

*) 
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(*  XIKtiLUDE 

CS’HDGWRT  *) 

(**) 

PROCEDURE 

CSHDGWRKVAR  CSRFILE 

TEXT; 

VAR  PAGE_NUMBER 

INTEGER; 

VAR  LINE_COUNT 

INTEGER; 

VAR  HEADING 

HEADING_TYPE 

VAR  PAGE_TYPE 

PAGES); 

SUBPROGRAM; 


(**) 

(*--■ 

— 

-*) 

(* 

*) 

(* 

^FUNCTION: 

*> 

(* 

THIS  ROUTINE 

CALLS 

THE  APPROPRIATE  HEADING  ROUTINE. 

*) 

(* 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME 

I/O 

DESCRIPTION 

*) 
+  \ 

(* 

CSRFILE 

I/O 

OUTPUT  FILE 

*) 

(* 

PAGE_NUMBER 

I/O 

CURRENT  PAGE  NUMBER 

*) 

(* 

LINE_COUNT 

0 

LINE  COUNT  ON  THE  CURRENT  PAGE 

*) 

(* 

HEADING 

I 

DEFINITION  OR  INDEX  HEADING 

*) 

(* 

PAGE_TYPE 

I 

TYPE  OF  HEADING  TO  PRINT 

*) 

(* 

*) 

(* 

$ COMMONS : 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

<* 

LANGUAGE:  IBM  PASCAL 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

*) 

<* 

^EXECUTION  PROCEDURE: 

*) 

<* 

INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

*) 

(* 

CASE  TYPE  OF  PAGE 

OF 

*) 

(* 

ENTITY  PAGE 

: 

WRITE  OUT  TO  THE  FILE  THE  ENTITY  HEADING. 

*) 

(* 

CLASS  PAGE 

• 

• 

WRITE  OUT  TO  THE  FILE  THE  CLASS  HEADING. 

*) 

(* 

DEFINED  TYPE  PAGE  : 

WRITE  OUT  TO  THE  FILE  THE  DEFINED  TYPE 

*) 

(* 

HEADING. 

*> 

(* 

SUBSCHEMA  PAGE 

• 

• 

WRITE  OUT  TO  THE  FILE  THE  SUBSCHEMA 

*) 

(* 

HEADING. 

*) 

(* 

*) 

(* 

^COMMENTS: 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 
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(*  7.INCLUDE  CSINDWRT  *) 

(**) 

PROCEDURE  CSINDWRT (VAR  IRC  :  RET_REC ; 

VAR  INDEX_TYPE  :  PAGES; 

VAR  LIST  :  LISTKEY; 

VAR  CSRFILE  :  TEXT; 

VAR  PAGE_NUMBER  :  INTEGER; 

VAR  CURRENT_PAGE  :  PAGE_PTR) ; 

SUBPROGRAM; 

<**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  WRITES  OUT  TO  A  FILE  AN  INDEX  FOR  AN  ENTITY,  *) 

(*  CLASS,  OR  SUBSCHEMA.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  INDEXJTYPE  I  TYPE  OF  INDEX  TO  BE  PRINTED  *) 

(*  LIST  I  ALPHABETIZED  LIST  OF  ENTITIES  *) 

(*  CSRFILE  I/O  THE  OUTPUT  FILE  *) 

(*  PAGE_NUMBER  I/O  THE  CURRENT  PAGE  NUMBER  *) 

(*  CURRENT JPAGE  I/O  POINTS  TO  A  PAGE  RECORD  WHICH  CONTAINS  *) 

(*  THE  PAGE  NUMBER  IN  THE  REPORT  FOR  THE  *) 

(*  ENTITY.  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT  *) 

(*  *  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  SET  THE  LIST  OF  ENTITIES  TO  BE  READ  IN  THE  FORWARD  DIRECTION.  *) 

(*  COUNT  THE  NUMBER  OF  ENTITIES  IN  THE  LIST.  *) 

(*  WRITE  OUT  THE  PROPER  PAGE  HEADING.  *) 

(*  FOR  X  =  1  TO  THE  NUMBER  OF  ENTITIES  *) 

(*  WRITE  OUT  THE  PROPER  PAGE  HEADING,  IF  NEW  PAGE  IS  NEEDED.  *) 

(*  READ  AN  ENTITY  FROM  THE  LIST  OF  ENTITIES.  *) 
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(* 

(* 

(* 

c* 

(* 

(* 

(* 

(* 

(* 

(* 


GET  THE  ENTITY’S  ADB. 

S  ora  10  m  file  m  pSTLNAME  am 

OH.  “  FILE  IHE  PAGE  “BEE  THAT  THE  EHTITI  BEGIK 

INCREMENT  THE  LINE  COUNT. 

^COMMENTS: 


^CHANGE  CONTROL: 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE 
(**) 

PROCEDURE 


CSINTWRT  *) 

CSINTWRT(VAR  IRC 

VAR  INT_KEY 
VAR  CSRFILE 
VAR  LINE_COUNT 


:  RET_REC; 

:  ENTKEY; 

:  TEXT; 

:  INTEGER); 


SUBPROGRAM; 

<**) 

(* - 

(* 

(*  $ FUNCTION: 

C*  THIS  ROUTINE  WRITES  OUT  AN  INTEGER  DEFINITON 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


^DESCRIPTION  OF  ARGUMENTS: 


NAME 

I/O 

DESCRIPTION 

===== 

ii 

ii 

n 

n 

ii 

ii 

n 

n 

n 

ii 

n 

IRC 

0 

INTERNAL  RETURN  CODE 

INT_KEY 

I 

INTEGER  KEY 

CSRFILE 

I/O 

THE  OUTPUT  FILE 

LINE_COUNT 

I/O 

CURRENT  LINE  COUNT 

$ COMMONS : 
NONE 


^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 


(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT 
^PROCESSING  DESCRIPTION: 


GET  THE  INTEGER'S  ADB. 

0UT  T0  THE  FILE  THE  INTEGER  DEFINITION 
INCREMENT  THE  LINE  COUNTER. 


$ COMMENTS : 


$ CHANGE  CONTROL: 


“*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  CSLOGWRT  *) 

(**) 

PROCEDURE  CSLOGWRT (VAR  IRC 

VAR  CSRFILE 
VAR  LINE  COUNT 


RET_REC; 

TEXT; 

INTEGER); 


SUBPROGRAM; 

(**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  WRITES  OUT  A  LOGICAL  DEFINITION 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 


(* 

(* 

<* 

NAME 

I/O 

DESCRIPTION 

IRC 

0 

RETURN  RECORD 

(* 

CSRFILE 

I/O 

THE  OUTPUT  FILE 

(* 

LINE_COUNT 

I/O 

CURRENT  LINE  COUNT 

(* 

(* 

$ COMMONS : 

(* 

NONE 

(* 

(* 

^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(* 

(*  WRITE  OUT  TO  THE  FILE  'LOGICAL;*. 

(*  INCREMENT  THE  LINE  COUNTER. 

(* 

(*  ^COMMENTS: 

(* 

(*  ^CHANGE  CONTROL: 

(* 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  ^.INCLUDE  CSMAIN  *) 

(**) 

PROCEDURE  CSMAIN(VAR  IRC  :  RET_REC; 

VAR  MSG  :  MESSAGE); 


(**) 

(*— 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


SUBPROGRAM; 


^FUNCTION: 

THIS  ROUTINE  SERVES  AS  THE  MAIN  DRIVER  FOR  THE  CONCEPTUAL 
SCHEMA  REPORT. 

^DESCRIPTION  OF  ARGUMENTS: 


NAME 

I/O 

DESCRIPTION 

IRC 

0 

INTERNAL  RETURN  CODE 

MSG 

0 

MESSAGE  RETURNED  INDICATING  IF  A  REPORT 
HAS  BEEN  PRODUCED 

$ COMMONS : 

NONE 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

$ EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT 
^PROCESSING  DESCRIPTION: 

INITIALIZE  THE  VARIABLES  USED  WITHIN  THIS  ROUTINE. 

WRITE  OUT  TO  THE  FILE  THE  REPORT  COVER. 

INITIALIZE  THE  PAGE  NUMBER  AND  PAGE  CHAIN. 

MAKE  A  LIST  OF  DEFINED  TYPES  WITHIN  THE  SCHEMA. 

ALPHABETIZE  THE  LIST  OF  DEFINED  TYPES. 

WRITE  OUT  TO  THE  FILE  THE  DEFINED  TYPES  WITHIN  THE  SCHEMA. 
DELETE  THE  LIST  OF  DEFINED  TYPES  WITHIN  THE  SCHEMA. 

MAKE  A  LIST  OF  GLOBAL  FIELDS  WITHIN  THE  SCHEMA. 

WRITE  OUT  TO  THE  FILE  THE  GLOBAL  FIELDS  WITHIN  THE  SCHEMA. 
DELETE  THE  LIST  OF  GLOBAL  FIELDS  WITHIN  THE  SCHEMA. 

MAKE  A  LIST  OF  ENTITIES  WITHIN  THE  SCHEMA. 

ALPHABETIZE  THE  LIST  OF  ENTITIES. 

WRITE  OUT  TO  THE  FILE  THE  ENTITIES  WITHIN  THE  SCHEMA. 

MAKE  A  LIST  OF  CLASSES  WITHIN  THE  SCHEMA. 

ALPHABETIZE  THE  LIST  OF  CLASSES. 


-*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  WRITE  OUT  TO  THE  FILE  THE  CLASSES  WITHIN  THE  SCHEMA.  *) 
(*  MAKE  A  LIST  OF  SUBSCHEMAS  WITHIN  THE  SCHEMA.  *) 
(*  ALPHABETIZE  THE  LIST  OF  SUBSCHEMAS.  *) 
(*  WRITE  OUT  TO  THE  FILE  THE  SUBSCHEMAS  WITHIN  THE  SCHEMA.  *) 
(*  WRITE  OUT  TO  THE  FILE  THE  ENTITY  INDEX.  *) 
(*  DELETE  THE  LIST  OF  ENTITIES.  *) 
(*  WRITE  OUT  TO  THE  FILE  THE  CLASS  INDEX.  *) 
(*  DELETE  THE  LIST  OF  CLASSES.  *) 
(*  WRITE  OUT  TO  THE  FILE  THE  SUBSCHEMA  INDEX.  *) 
(*  DELETE  THE  LIST  OF  SUBSCHEMAS.  *) 
(*  IF  NO  MODEL  EXISTS,  WRITE  APPROPRIATE  MESSAGE.  *) 
(*  DISPOSE  OF  POINTERS  USED  IN  THIS  ROUTINE.  *) 
(*  *) 
(*  $ COMMENTS :  *) 
(*  *) 
(*  WITHIN  THE  INCLUDE  FILE  'SCECON',  ONE  CAN  SET  THE  MAXIMUM  *) 
(*  NUMBER  OF  LINES  PER  PAGE  IN  THE  REPORT.  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  CSNEWPG  *) 

(**) 

PROCEDURE  CSNEWPG (VAR  CSRFILE  :  TEXT; 

VAR  PAGE_NUMBER  :  INTEGER; 

VAR  LINE_COUNT  :  INTEGER); 


SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  CREATES  A  NEW  PAGE  IN  THE  CONCEPTUAL  SCHEMA  *) 

(*  REPORT.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  CSRFILE  I/O  OUTPUT  FILE  *) 

(*  PAGE_NUMBER  I/O  CURRENT  PAGE  NUMBER  *) 

(*  LINE_COUNT  0  LINE  COUNT  ON  THE  CURRENT  PAGE  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INCREMENT  THE  PAGE  NUMBER.  *) 

(*  CREATE  A  NEW  PAGE  IN  THE  FILE.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  CURRENT  PAGE  NUMBER.  *) 

(*  INCREMENT  THE  LINE  COUNTER.  *) 

(*  *) 

(*  -^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  7.INCLUDE  CSPTRWRT  *) 

(**) 

PROCEDURE  CSPTRWRT (VAR  IRC 

VAR  POINTER_KEY 
VAR  CSRFILE 
VAR  PAGE_NUMBER 
VAR  LINE_COUNT 
VAR  INDENT 
VAR  PAGE  TYPE 


RET_REC; 

ENT KEY; 

TEXT; 

INTEGER; 

INTEGER; 

INTEGER; 

PAGES); 


(**) 

(*— 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


SUBPROGRAM; 


^FUNCTION: 

THIS  ROUTINE  WRITES  OUT  A  POINTER  DEFINITION 
^DESCRIPTION  OF  ARGUMENTS: 


NAME 

I/O 

DESCRIPTION 

IRC 

0 

INTERNAL  RETURN  CODE 

POINTERJCEY 

I 

POINTER  KEY 

CSRFILE 

I/O 

OUTPUT  FILE 

PAGE_NUMBER 

I/O 

CURRENT  PAGE  NUMBER 

LINE_COUNT 

I/O 

CURRENT  LINE  COUNT 

INDENT 

I/O 

NUMBER  OF  SPACES  TO  INDENT 

PAGE_TYPE 

I/O 

TYPE  OF  REPORT  PAGE 

$ COMMONS : 

NONE  ■ 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT 

^PROCESSING  DESCRIPTION: 

GET  THE  POINTER'S  ADB, 

WRITE  OUT  TO  THE  FILE  'POINTER  TO  ( ' . 

CREATE  A  NEW  PAGE,  IF  NECESSARY. 

SET  THE  LIST  OF  CONSTITUENTS  OF  THE  POINTER  TO  BE  READ  IN  THE 
FORWARD  DIRECTION. 

COUNT  THE  NUMBER  OF  CONSTITUENTS  IN  THE  LIST. 

FOR  Y  =  1  TO  THE  NUMBER  OF  CONSTITUENTS  IN  THE  LIST 


■*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  CREATE  A  NEW  PAGE,  IF  NECESSARY.  *) 

(*  READ  A  CONSTITUENT  FROM  THE  LIST  OF  CONSTITUENTS.  *) 

(*  GET  THE  CONSTITUENT’S  ADB.  *) 

(*  WRITE  OUT  TO  THE  FILE  A  CONSTITUENT  (ENTITY  OR  CLASS)  *) 

(*  INCREMENT  THE  LINE  COUNTER.  *) 

(*  WRITE  OUT  TO  THE  FILE  ')'.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE 
(**) 

PROCEDURE 


CSRELWRT  *) 

CSRELWRT(VAR  IRC 

VAR  REAL_KEY 
VAR  CSRFILE 
VAR  LINE  COUNT 


RET_REC; 
ENTKEY ; 
TEXT; 
INTEGER); 


(**) 

(*-- 

SUBPROGRAM; 

- *) 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

THIS  ROUTINE  WRITES  OUT  A  REAL  DEFINITION 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME  I/O  DESCRIPTION 

*) 

(* 

(* 

*) 

*) 

IRC  0  INTERNAL  RETURN  CODE 

(* 

REAL_KEY  I  REAL  KEY 

*) 

(* 

CSRFILE  I/O  THE  OUTPUT  FILE 

*) 

(* 

LINE_COUNT  I/O  CURRENT  LINE  COUNT 

*) 

(* 

*) 

(* 

^COMMONS : 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*> 

(* 

*) 

(* 

$ EXECUTION  PROCEDURE: 

*) 

(* 

INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

*) 

(* 

GET  THE  INTEGER'S  ADB. 

*) 

(* 

WRITE  OUT  TO  THE  FILE  THE  REAL  DEFINITION. 

*> 

(* 

INCREMENT  THE  LINE  COUNTER. 

*) 

(* 

*) 

(* 

$ COMMENTS : 

*) 

(* 

*) 

(* 

^CHANGE  CONTROL: 

*) 

(* 

*) 
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(*  %INCLUDE  CSRMAIN  *) 

(**) 

PROCEDURE  CSRMAIN(VAR  IRC  :  RET_REC; 

VAR  MSG  :  MESSAGE); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  PROVIDES  THE  CAPABILITIES  TO  GENERATE,  BROWSE,  *) 

(*  AND  PRINT  THE  CONCEPTUAL  SCHEMA  REPORT.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  MSG  I/O  PANEL  MESSAGE  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  -  *) 
(*  DISPLAY  THE  CONCEPTUAL  SCHEMA  REPORT  MAIN  MENU  *) 

(*  DETERMINE  WHICH  OPTION  WAS  CHOSEN  AND  ACT  ACCORDINGLY:  *) 

(*  —  GENERATE  THE  CONCEPTUAL  SCHEMA  REPORT  *) 

(*  —  BROWSE  THE  CONCEPTUAL  SCHEMA  REPORT  *) 

(*  —  PRINT  THE  CONCEPTUAL  SCHEMA  REPORT  *) 

(*  —  RETURN  TO  THE  MAIN  MENU  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

C*  *) 
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(*  /.INCLUDE  CSRMENU  *) 

(**) 

PROCEDURE  CSRMENU (VAR  MESS  :  MESSAGE; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  DISPLAYS  THE  CONCEPTUAL  SCHEMA  REPORT  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  INITITIALIZE  THE  VARIABLES  *) 

(*  PERMIT  THE  COMMUNICATION  BETWEEN  PANEL  VARIABLES  AND  PROGRAM  *) 

(*  VARIABLES  *) 

(*  DISPLAY  THE  CONCEPTUAL  SCHEMA  REPORT  MENU  *) 

(*  DETERMINE  THE  ACTION  SELECTED  FROM  THE  MENU  *) 

(*  REMOVE  THE  CORRESPONDENCE  BETWEEN  PANEL  VARIABLES  AND  PROGRAM  *) 

(*  VARIABLES  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  CSRPTCVR  *) 

(**) 

PROCEDURE  CSRPTCVR(VAR  CSRFILE  :  TEXT); 

SUBPROGRAM; 

<**) 

(*  *) 
(*  $ FUNCTION;  *) 

(*  schema°UTINE  prints  out  the  REP0RT  cover  FOR  THE  CONCEPTUAL  *) 


^DESCRIPTION  OF  ARGUMENTS: 


CSRFILE 


I/O  DESCRIPTION 
I/O  OUTPUT  FILE 


^COMMONS ; 
NONE 


^ENVIRONMENT: 

LANGUAGE;  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

$ EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT 
^PROCESSING  DESCRIPTION: 

CREATE  A  NEW  PAGE. 

WRITE  'CONCEPTUAL  SCHEMA  REPORT’. 

$ COMMENTS: 

^CHANGE  CONTROL: 
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(*  %INCLUDE  CSSTGWRT  *) 

(**) 

PROCEDURE  CSSTGWRT (VAR  IRC 

VAR  STRING_KEY 
VAR  CSRFILE 
VAR  LINE  COUNT 


RET_REC; 
ENTKEY ; 
TEXT; 
INTEGER) ; 


SUBPROGRAM; 

(**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  WRITES  OUT  A  STRING  DEFINITON 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 

(*  NAME  I/O  DESCRIPTION 

(*  IRC  0  INTERNAL  RETURN  CODE 

(*  STRINGJCEY  I  STRING  KEY 

(*  CSRFILE  I/O  THE  OUTPUT  FILE 

(*  LINE_COUNT  I/O  CURRENT  LINE  COUNT 

(* 

(*  ^COMMONS: 

(*  NONE 

(* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION -PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT 

(* 

(*  ^PROCESSING  DESCRIPTION: 

<* 

(*  GET  THE  STRING'S  ADB. 

(*  WRITE  OUT  TO  THE  FILE  THE  STRING  DEFINITION. 

(*  INCREMENT  THE  LINE  COUNTER. 

(* 

(*  $ COMMENTS: 

(* 

(*  $ CHANGE  CONTROL: 

(* 


■*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  CSSTRWRT  *) 

(**) 

PROCEDURE  CSSTRWRT (VAR  IRC  :  RET_REC ; 

VAR  STRUCTURE_KEY  :  ENTKEY; 

VAR  CSRFILE  :  TEXT; 

VAR  PAGE_NUMBER  :  INTEGER; 

VAR  LINE_COUNT  :  INTEGER; 

VAR  PAGE_TYPE  :  PAGES); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  WRITES  OUT  A  STUCTURE  DEFINITION  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  STRUCTURE_KEY  I  STRUCTURE  KEY  *) 

(*  CSRFILE  I/O  THE  OUTPUT  FILE  *) 

(*  PAGE_NUMBER  I/O  CURRENT  PAGE  NUMBER  *) 

(*  LINE_COUNT  I/O  CURRENT  LINE  COUNT  *) 

(*  PAGE_TYPE  I/O  TYPE  OF  REPORT  PAGE  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  GET  THE  STRUCTURE'S  ADB.  *) 

(*  WRITE  OUT  TO  THE  FILE  'STRUCTURE'.  *) 

(*  INCREMENT  THE  LINE  COUNTER.  *) 

(*  SET  THE  LIST  OF  CONSTITUENTS  TO  BE  READ  IN  THE  FORWARD  DIRECTION.*) 

(*  COUNT  THE  NUMBER  OF  CONSTITUENTS  IN  THE  LIST.  *) 

(*  FOR  X  =  1  TO  THE  NUMBER  OF  CONSTITUENTS  IN  THE  LIST  *) 

(*  READ  A  CONSTITUENT  FROM  THE  LIST.  *) 

(*  GET  THE  CONSTITUENT'S  ADB.  *) 

(*  CREATE  A  NEW  PAGE,  IF  NECESSARY.  _  *) 
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(* 

WRITE  OUT  TO  THE  FILE  THE  FIELD 

NAME. 

*) 

(* 

SET  THE  TYPE  LIST  TO  BE  READ  IN 

THE  FORWARD  DIRECTION. 

*) 

(* 

GET  THE  TYPE'S  KEY. 

*) 

(* 

GET  THE  TYPE'S  ADB. 

*) 

(* 

CASE  TYPE_ADB.ENT_KIND  OF 

*) 

(* 

INTEGER 

WRITE  OUT 

THE 

INTEGER  DEFINITION. 

*) 

(* 

REAL 

WRITE  OUT 

THE 

REAL  DEFINITION. 

*) 

(* 

STRING 

WRITE  OUT 

THE 

STRING  DEFINITION. 

*) 

(* 

LOGICAL 

WRITE  OUT 

THE 

LOGICAL  DEFINITION. 

*) 

(* 

ARRAY 

WRITE  OUT 

THE 

ARRAY  DEFINITION. 

*) 

(* 

DEFINED  TYPE 

WRITE  OUT 

THE 

DEFINED  TYPE  DEFINITION. 

*) 

(* 

POINTER 

WRITE  OUT 

THE 

POINTER  DEFINITION. 

*) 

(* 

CREATE  A  NEW  PAGE,  IF  NECESSARY 

*) 

(* 

WRITE  OUT  TO  THE  FILE  'END;'. 

*) 

(* 

*) 

(* 

$ COMMENTS : 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

*) 
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(*  %INCLUDE  CSSUBHDG  *) 
(**) 

PROCEDURE  CSSUBHDG(VAR 

VAR 

VAR 

VAR 


CSRFILE  : 
HEADING 
PAGE_NUMBER  : 
LINE  COUNT  : 


TEXT; 

HEADINGJTYPE; 

INTEGER; 

INTEGER); 


SUBPROGRAM; 

(**) 

(* - 

(* 

(*  $  FUNCTION: 

(*  THIS  ROUTINE  WRITES  OUT  A  SUBSCHEMA  HEADING  ON  A  NEW  PAGE. 

(* 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 


(* 

NAME 

I/O 

DESCRIPTION 

(* 

==== 

-== 

ii 

n 

ii 

ii 

ii 

ii 

ii 

ii 

u 

ii 

n 

(* 

CSRFILE 

I/O 

OUTPUT  FILE 

(* 

HEADING 

I 

DEFINITION  OR  INDEX  HEADING 

(* 

PAGE_NUMBER 

I/O 

CURRENT  PAGE  NUMBER 

(* 

LINE_COUNT 

0 

LINE  COUNT  ON  THE  CURRENT  PAGE 

(* 

(* 

$ COMMONS: 

(* 

NONE 

(* 

(* 

^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(* 

(*  CREATE  A  NEW  PAGE. 

(*  WRITE  OUT  TO  THE  FILE  THE  APPROPRIATE  HEADING  (DEFINITION  OR 
(*  INDEX). 

(*  INCREMENT  THE  LINE  COUNTER. 

(* 

(*  $ COMMENTS : 

(* 

(*  $ CHANGE  CONTROL: 

(* 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  CSSUBWRT  *) 
(**) 

PROCEDURE  CSSUBWRT (VAR 

VAR 

VAR 

VAR 

VAR 


IRC 

SUBSCHEMA_LIST 
CSRFILE 
PAGE_NUMBER 
CURRENT  PAGE 


RET_REC; 
LISTKEY; 
TEXT; 
INTEGER; 
PAGE_PTR) ; 


SUBPROGRAM; 

(**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  WRITES  OUT  SUBSCHEMA  DEFINITIONS  TO  A  FILE. 

(* 

(*  ^DESCRIPTION  0?  ARGUMENTS: 


(* 

NAME 

I/O 

DESCRIPTION 

<* 

===== 

===== 

ti 

ii 

ii 

ii 

ii 

ii 

ii 

ii 

n 

ii 

n 

(* 

IRC 

0 

INTERNAL  RETURN  CODE 

(* 

SUBSCHEMA_LIST  I 

ALPHABETIZED  LIST  OF  CLASSES 

(* 

CSRFILE 

I/O 

THE  OUTPUT  FILE 

(* 

PAGE_NUMBER 

I/O 

THE  CURRENT  PAGE  NUMBER 

(* 

(* 

CURRENT_PAGE 

I/O 

POINTS  TO  THE  CURRENT  PAGE  RECORD  IN 
THE  CHAIN 

(* 

(*  $ COMMONS : 

(*  NONE 

(* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(* 

(*  SET  THE  LIST  OF  SUBSCHEMAS  TO  BE  READ  IN  THE  FORWARD  DIRECTION. 
(*  COUNT  THE  NUMBER  OF  SUBSCHEMAS  IN  THE  LIST. 

(*  FOR  X  =  1  TO  THE  NUMBER  OF  SUBSCHEMAS  IN  THE  LIST 

(*  WRITE  OUT  TO  THE  FILE  THE  SUBSCHEMA  HEADING. 

(*  UPDATE  THE  PAGE  RECORD  CHAIN. 

(*  READ  A  SUBSCHEMA  FROM  THE  LIST  OF  SUBSCHEMAS. 

(*  GET  THE  SUBSCHEMA'S  ADB. 

(*  WRITE  OUT  TO  THE  FILE  THE  SUBSCHEMA  NAME. 

(*  SET  THE  LIST  OF  CONSTITUENTS  TO  BE  READ  IN  THE  FORWARD 
(*  DIRECTION. 


■*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  COUNT  THE  NUMBER  OF  CONSTITUENTS  IN  THE  LIST.  *) 

(*  FOR  Y  =  1  TO  THE  NUMBER  OF  CONSTITUENTS  IN  THE  LIST  *) 

(*  READ  A  CONSTITUENT  FROM  THE  LIST  OF  CONSTITUENTS  *) 

(*  GET  THE  CONSTITUENT’S  ADB.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  HEADING  ON  A  NEW  PAGE,  IF  *) 

(*  NECESSARY.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  CONSTITUENT  (ENTITY  OR  CLASS).  *) 

(*  WRITE  OUT  TO  THE  FILE  'END;'.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  CSSUPHDG  *) 

(**) 

PROCEDURE  CSSUPHDG(VAR  CSRFILE 

VAR  HEADING 


VAR  PAGE  NUMBER 


VAR  LINE_COUNT 


TEXT; 

HEADINGJTYPE; 
INTEGER; 
INTEGER) ; 


SUBPROGRAM; 

(**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  WRITES  OUT  A  SUPERTYPE  HEADING  ON  A  NEW  PAGE. 

<* 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 


(* 

(* 

(* 

NAME 

I/O 

DESCRIPTION 

CSRFILE 

I/O 

OUTPUT  FILE 

(* 

HEADING 

I 

DEFINITION  OR  INDEX  HEADING 

(* 

PAGE_NUMBER 

I/O 

CURRENT  PAGE  NUMBER 

(* 

LINE_COUNT 

0 

LINE  COUNT  ON  THE  CURRENT  PAGE 

(* 

(*  $ COMMONS : 

(*  NONE 

(* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(* 

(*  CREATE  A  NEW  PAGE. 

(*  WRITE  OUT  TO  THE  FILE  THE  APPROPRIATE  SUPERTYPE  HEADING 
(*  DEFINITION  OR  INDEX. 

(*  INCREMENT  THE  LINE  COUNTER. 

(* 

(*  $ COMMENTS: 

(* 

(*  $ CHANGE  CONTROL: 

(* 


•*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  CSSUPWRT  *) 

(**) 

PROCEDURE  CSSUPWRT(VAR  IRC  :  RET_REC; 

VAR  SUPERTYPE_LI ST  :  LISTKEY; 

VAR  CSRFILE  :  TEXT; 

VAR  PAGE_NUMBER  :  INTEGER; 

VAR  CURRENT_PAGE  :  PAGE_PTR) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  WRITES  OUT  SUPERTYPE  DEFINITIONS  TO  A  FILE  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  SUPERTYPE_LI ST  I  ALPHABETIZED  LIST  OF  SUPERTYPES  *) 

(*  CSRFILE  I/O  THE  OUTPUT  FILE  *) 

(*  PAGE_NUMBER  I/O  THE  CURRENT  PAGE  NUMBER  *) 

(*  CURRENT_PAGE  I/O  POINTS  TO  THE  CURRENT  PAGE  RECORD  IN  *) 

(*  THE  CHAIN.  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

<*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

<*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  SET  THE  LIST  OF  ENTITIES  TO  BE  READ  IN  THE  FORWARD  DIRECTION.  *) 

(*  COUNT  THE  NUMBER  OF  ENTITIES  IN  THE  LIST.  *) 

(*  FOR  X  =  1  TO  THE  NUMBER  OF  ENTITIES  IN  THE  LIST  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  ENTITY  HEADING.  *) 

(*  UPDATE  THE  PAGE  RECORD  CHAIN.  *) 

(*  READ  AN  ENTITY  FROM  THE  LIST  OF  ENTITIES.  *) 

(*  GET  THE  ENTITY'S  ADB.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  ENTITY  NAME  AND  NUMBER.  *) 


(*  SET  THE  LIST  OF  CONSTITUENTS  OF  THE  ENTITY  TO  BE  READ  IN  V'v.  *) 
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FORWARD  DIRECTION.  *) 

COUNT  THE  NUMBER  OF  CONSTITUENTS  IN  THE  LIST.  *) 

FOR  Y  =  1  TO  THE  NUMBER  OF  CONSTITUENTS  IN  THE  LIST  *) 

READ  A  CONSTITUENT  FROM  THE  LIST.  *) 

GET  THE  CONSTITUENT'S  ADB.  *) 

CREATE  A  NEW  PAGE,  IF  NECESSARY.  *) 

WRITE  OUT  TO  THE  FILE  A  FIELD  NAME.  *) 

SET  THE  TYPE  OF  FIELD  TO  BE  READ  IN  THE  FORWARD  DIRECTION.  *) 
GET  THE  TYPE'S  KEY.  *) 

GET  THE  TYPE'S  ADB.  *) 

CASE  TYPE_ADB . ENT_KIND  OF  *) 

INTEGER  :  WRITE  OUT  THE  INTEGER  DEFINITION  *) 

REAL  :  WRITE  OUT  THE  REAL  DEFINITION  *) 

STRING  :  WRITE  OUT  THE  STRING  DEFINITION  *) 

LOGICAL  :  WRITE  OUT  THE  LOGICAL  DEFINITION  *) 

ARRAY  :  WRITE  OUT  THE  ARRAY  DEFINITION  *) 

DEFINED  TYPE  :  WRITE  OUT  THE  DEFINED  TYPE  DEFINITION  *) 

POINTER  :  WRITE  OUT  THE  POINTER  DEFINITION  *) 

WRITE  OUT  TO  THE  FILE  'END;'.  *) 

*) 

^COMMENTS:  *) 

*) 

$ CHANGE  CONTROL:  *) 

*) 
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(*  %INCLUDE  CSTYPWRT  *) 

(**) 

PROCEDURE  CSTYPWRT (VAR  IRC  :  RET_REC ; 

VAR  DEF_TYP_LIST  :  LISTKEY; 

VAR  CSRFILE  :  TEXT; 

VAR  PAGE_NUMBER  :  INTEGER); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  WRITES  OUT  THE  DEFINED  TYPE  DEFINITIONS  TO  *) 

(*  A  FILE.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  DEF_TYP_LIST  I  ALPHABETIZED  LIST  OF  DEFINED  TYPES  *) 

(*  CSRFILE  I/O  THE  OUTPUT  FILE  *) 

(*  PAGE_NUMBER  I/O  THE  CURRENT  PAGE  NUMBER  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  CONCEPTUAL  SCHEMA  REPORT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  SET  THE  LIST  OF  DEFINED  TYPES  TO  BE  READ  IN  THE  FORWARD  *) 

(*  DIRECTION.  *) 

(*  COUNT  THE  NUMBER  OF  DEFINED  TYPES  IN  THE  LIST.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  DEFINED  TYPE  DEFINITION  HEADING.  *) 

(*  FOR  X  =  1  TO  THE  NUMBER  OF  DEFINED  TYPES  IN  THE  LIST  *) 

(*  READ  A  DEFINED  TYPE  FROM  THE  LIST.  *) 

(*  GET  THE  DEFINED  TYPE’S  ADB.  *) 

(*  WRITE  OUT  THE  DEFINED  TYPE  HEADING,  IF  NECESSARY.  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  DEFINED  TYPE  NAME.  *) 

(*  SET  THE  LIST  OF  CONSTITUENTS  TO  BE  READ  IN  THE  FORWARD  *) 

(*  DIRECTION.  *) 

(*  READ  THE  CONSTITUENT  FROM  THE  LIST  OF  CONSTITUENTS.  *) 
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(*  GET  THE  CONSTITUENT'S  ADB.  *) 

(*  CASE  CONSTITUENT_ADB . ENT_KIND  OF  *) 


(* 

INTEGER 

WRITE 

OUT 

(* 

REAL 

WRITE 

OUT 

(* 

STRING 

WRITE 

OUT 

(* 

LOGICAL 

WRITE 

OUT 

(* 

ARRAY 

WRITE 

OUT 

(* 

DEFINED  TYPE 

WRITE 

OUT 

(* 

POINTER 

WRITE 

OUT 

(* 

ENUMERATION 

WRITE 

OUT 

(* 

STRUCTURE 

WRITE 

OUT 

(* 

INCREMENT  THE  LINE  COUNTER. 

(* 

(* 

^COMMENTS : 

c* 

(* 

$ CHANGE  CONTROL: 

(* 

THE  INTEGER  DEFINITION.  *) 
THE  REAL  DEFINITION.  *) 
THE  STRING  DEFINITION.  *) 
THE  LOGICAL  DEFINITION.  *) 
THE  ARRAY  DEFINITION.  *) 
THE  DEFINED  TYPE  DEFINITION.  *) 
THE  POINTER  DEFINITION.  *) 
THE  ENUMERATION  DEFINITION.  *) 
THE  STRUCTURE  DEFINITION.  *) 


*) 

*) 

*) 

*) 

*) 

*) 
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(*  BEGIN  %INCLUDE  DDABNDS  *********************************************) 
(*  *) 
PROCEDURE  DDABNDS  (  VAR  DDFILE  :  T_FILE_VARIANT ; 

CONST  NO_OF_DIMEN  :  INTEGER; 

CONST  STARTING_ARRAY_POSITION  :  INTEGER; 

VAR  POINTER  :  T_VARIANT_POINTER; 

VAR  c  ENTITY_SIZE  :  INTEGER; 

VAR  ENTITY_POSITION  :  INTEGER; 

VAR  ENUM_INDEX  :  INTEGER  ); 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

<* 


SUBPROGRAM; 

*) 

$ FUNCTION:  *) 

WRITE  THE  LOW-BOUND  AND  UPPER-BOUND  FOR  THE  ARRAY  ATTRIBUTE  *) 

*) 

^DESCRIPTION  OF  ARGUMENTS:  *) 

NAME  I/O  DESCRIPTION  *) 

DDFILE  0  DATA  DICTIONARY  SEQUENTIAL  FILE  *) 

NO_OF_DIMEN  I  NUMBER  OF  ARRAY  DIMENSION  *) 

STARTING_ARRAY_PO  I  STARTING  POSITION  IN  THE  ARRAY  TABLE  *) 

POINTER  I  POINTER  TO  ARRAY  TABLE  *) 

ENTITY_SIZE  0  NUMBER  OF  RECORDS  IN  THE  DEFINITION  *) 

ENTITY_POSITION  0  FIRST  RECORD  OF  THE  DEFINITION  *) 

*) 

^COMMONS:  *) 

*) 

^ENVIRONMENT :  *) 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

*) 

^EXECUTION  PROCEDURE:  *) 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

*) 

^PROCESSING  DESCRIPTION:  *) 

LOOP  THROUGH  THE  NUMBER  OF  DIMENSIONS  *) 

WRITE  LOW-BOUND  AND  UPPER-BOUND  *) 

END  LOOP  *) 

*) 

• ^COMMENTS:  *) 

*) 

$ CHANGE  CONTROL:  *) 

ORIGINATED:  23  MARCH  1987,  M.  H.  CHOI,  DBMA  *) 

*) 


END  %INCLUDE  DDABNDS  **********************************************) 
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(*  BEGIN  ^INCLUDE  DDADB 


<* 

PROCEDURE  DDADB  (  VAR 

CONST 

CONST 

CONST 

VAR 

VAR 

SUBPROGRAM; 


***********************************************) 

*) 

T_FILE_VARIANT; 

T_RUN_TIME; 

INTEGER; 

T_PS_ORDER; 

INTEGER; 

INTEGER  ); 


DDFILE 
RUNTIME 
ENTRY 
PS_ORDER 
ENTITY_SIZE  : 
ENTITY  POSITION: 


(*  *) 

(*  $ FUNCTION:  *) 

(*  WRITE  THE  BASIC  RECORD  OF  AN  ENTITY  TO  A  SEQUENTIAL  FILE  *) 


(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME 

I/O 

DESCRIPTION 

*) 

(* 

===== 

=== 

*) 

(* 

DDFILE 

I 

DATA  DICTIONARY  SEQUENTIAL  FILE 

*) 

(* 

RUNTIME 

I 

CONTAINS  THE  ENTITY  DEFINITION 

*) 

(* 

ENTRY 

I 

ENTRY  ORDER  IN  THE  DEFINITION 

*) 

(* 

PS_ORDER 

I 

LIST  OF  PHYSICAL  SCHEMA  ORDER 

*) 

(* 

ENTITY_SIZE 

0 

NUMBER  OF  RECORDS  IN  THE  DEFINITION 

*) 

(* 

ENTITY_POSITION 

0 

FIRST  RECORD  OF  THE  DEFINITION 

*) 

(* 

*) 

(* 

$ COMMONS : 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

(SEGMENT  SUBPROGRAM) 

*) 

(* 

HARDWARE  SYSTEM: 

IBM 

360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 

*) 

(* 

*) 

<* 

^PROCESSING  DESCRIPTION: 

*> 

(* 

WRITE  BASIC  RECORD 

*) 

(* 

*) 

(* 

^COMMENTS: 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

ORIGINATED:  17  MARCH 

1987,  M.  H.  CHOI,  DBMA 

*) 

(* 

*) 

(* 

END  ^INCLUDE  DDADB  *************************************************) 

Cl  PS560240032U 
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(*  BEGIN  %INCLUDE  DDARRAY  *********************************************) 


PROCEDURE  DDARRAY  (  VAR  DDFILE  : 

CONST  RUNTIME  : 

CONST  ENTRY  : 

CONST  PS_ORDER 
VAR  ENTITY_SIZE  : 

VAR  ENTITY_POSITION 

VAR  ATT_SIZE  : 

SUBPROGRAM; 


T_F I LE_VAR I ANT ; 
T_RUN_TIME ; 
INTEGER; 
T_PS_ORDER; 
INTEGER; 

:  INTEGER; 
INTEGER  ); 


^FUNCTION: 

WRITE  THE  ARRAY  ATTRIBUTE  OF  AN  ENTITY  TO  A  SEQUENTIAL  FILE 


^DESCRIPTION  OF  ARGUMENTS: 


DESCRIPTION 


DDFILE 

RUNTIME 

ENTRY 

PS_ORDER 

ENTITY_SIZE 

ENTITY_POSITION 

ATT_SIZE 


DATA  DICTIONARY  SEQUENTIAL  FILE 
CONTAINS  THE  ENTITY  DEFINITION 
ENTRY  ORDER  IN  THE  DEFINITION 
LIST  OF  PHYSICAL  SCHEMA  ORDER 
NUMBER  OF  RECORDS  IN  THE  DEFINITION 
FIRST  RECORD  OF  THE  DEFINITION 
SIZE  OF  ARRAY  ATTRIBUTE 


^COMMONS : 


^ENVIRONMENT : 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 

^PROCESSING  DESCRIPTION: 

OBTAIN  THE  NUMBER  OF  DIMENSIONS 

OBTAIN  THE  STARTING  POSITION  OF  ARRAY  TABLE 

CASE  DATA  TYPE  OF 


IN-ADB 


IN-CL 


END  CASE 


WRITE  BASIC  DEFINITION 

DDALIST  (  EXTERNAL  SUBPROGRAM  FOR  LOW-BOUND  AND 
UPPER-BOUND  ) 

WRITE  BASIC  DEFINITION 

DDCL  (  EXTERNAL  SUBPROGRAM  FOR  CONSTITUENT  LIST) 
DDALIST  (  EXTERNAL  SUBPROGRAM  FOR  LOW-BOUND  AND 
UPPER-BOUND  ) 
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(*  $ COMMENTS :  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 
(*  ORIGINATED:  17  MARCH  1987,  M.  H.  CHOI,  DBMA  *) 
(*  *) 
(*  END  %INCLUDE  DDARRAY  **********************************************) 
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(*  BEGIN  %INCLUDE  DDCL  ************************************************) 
(*  *) 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 


DDCL  (  VAR 

DDFILE  : 

T_FILE_VARIANT 

CONST 

RUNTIME  : 

T_RUN_TIME; 

CONST 

ENTRY  : 

INTEGER; 

VAR 

ENTITY_SIZE  : 

INTEGER; 

VAR 

ENTITY_POSITION: 

INTEGER  ); 

SUBPROGRAM; 

^FUNCTION: 

WRITE  THE  CONSTITUENT  REFERENCES  OF  AN  ENTITY  TO  A 
SEQUENTIAL  FILE 

^DESCRIPTION  OF  ARGUMENTS: 


NAME 

DDFILE 

RUNTIME 

ENTRY 

ENTITY_SIZE 
ENTITY  POSITION 


I/O  DESCRIPTION 


0 

I 

I 

0 

0 


DATA  DICTIONARY  SEQUENTIAL  FILE 
CONTAINS  THE  ENTITY  DEFINITION 
ENTRY  ORDER  IN  THE  DEFINITION 
NUMBER  OF  RECORDS  IN  THE  DEFINITION 
FIRST  RECORD  OF  THE  DEFINITION 


$ COMMONS : 


^ENVIRONMENT : 

LANGUAGE:  IBM  PASCAL 
HARDWARE  SYSTEM:  IBM 


(SEGMENT  SUBPROGRAM) 
360/370/4341/4381 


*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 

END  %INCLUDE  DDCL  **************************************************) 


^EXECUTION  PROCEDURE: 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 

^PROCESSING  DESCRIPTION: 

IF  NOT  ARRAY  ATTRIBUTE  THEN 
WRITE  BASIC  DEFINITION 
END  IF 

OBTAIN  THE  NUMBER  OF  ELIGIBLE  KINDS 

OBTAIN  STARTING  POSITION  OF  CONSTITUENT  LIST  TABLE 

LOOP  THROUGH  THE  NUMBER  OF  ELIGIBLE  KINDS 

WRITE  ELIGIBLE  KIND  IN  THE  CONSTITUENT  LIST  TABLE 
END  LOOP 


^COMMENTS: 

$ CHANGE  CONTROL: 
ORIGINATED: 


17  MARCH  1987,  M.  H.  CHOI,  DBMA 
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(* 

BEGIN  %INCLUDE  DDCLASS 

*********************************************) 

(* 

*) 

PROCEDURE  DDCLASS  (  CONST 

LIST_OF_CLASS  :  LISTKEY; 

VAR 

DDFILE 

;  :  T_FILE_VARIANT ; 

VAR 

DDINX 

:  T_INX_FILE; 

VAR 

ENTITY_POSITION:  INTEGER  ); 

SUBPROGRAM; 

(* 

*) 

(* 

^FUNCTION: 

*) 

<* 

WRITE  THE  CLASS 

KINDS 

TO  A  SEQUENTIAL  FILE 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME 

I/O 

DESCRIPTION 

*) 

*\ 

(* 

DDFILE 

I 

DATA  DICTIONARY  SEQUENTIAL  FILE 

) 

*) 

(* 

RUNTIME 

I 

CONTAINS  THE  ENTITY  DEFINITION 

*) 

(* 

ENTRY 

I 

ENTRY  ORDER  IN  THE  DEFINITION 

*) 

(* 

PS_ORDER 

I 

LIST  OF  PHYSICAL  SCHEMA  ORDER 

*) 

(* 

ENTITY_SIZE 

0 

NUMBER  OF  RECORDS  IN  THE  DEFINITION 

*) 

(* 

ENTITY_POSITION 

0 

FIRST  RECORD  OF  THE  DEFINITION 

*) 

(* 

*) 

(* 

^COMMONS : 

*) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

(*  *> 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  WRITE  BASIC  RECORD  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  ORIGINATED:  08  MAY  1987,  M.  H.  CHOI,  DBMA  *) 

<*  *) 


(*  END  %INCLUDE  DDCLASS  ***********************************************) 
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(*  BEGIN  %INCLUDE  DDENTITY  ********************************************) 
(*  *) 
PROCEDURE  DDENTITY  (  CONST  LIST_OF_ENTITIES  :  LISTKEY; 


VAR 

DDFILE  : 

T_FILE_VARIANT ; 

VAR 

DDINX  : 

T_INX_FILE ; 

VAR 

ENTITY_POSITION: 

INTEGER; 

VAR 

IRC  : 

RET_REC  ); 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


SUBPROGRAM; 

*) 


$ FUNCTION:  *) 

WRITE  THE  ENTITY  DEFINITIONS  TO  A  SEQUENTIAL  FILE  *) 

*) 

^DESCRIPTION  OF  ARGUMENTS:  *) 

NAME  I/O  DESCRIPTION  *) 

DDFILE  I  DATA  DICTIONARY  SEQUENTIAL  FILE  *) 

RUNTIME  I  CONTAINS  THE  ENTITY  DEFINITION  *) 

ENTRY  I  ENTRY  ORDER  IN  THE  DEFINITION  *) 

PS_ORDER  I  LIST  OF  PHYSICAL  SCHEMA  ORDER  *) 

ENTITY_SIZE  0  NUMBER  OF  RECORDS  IN  THE  DEFINITION  *) 

ENTITY_POSITION  0  FIRST  RECORD  OF  THE  DEFINITION  *) 

*) 

$ COMMONS:  *) 

*) 

^ENVIRONMENT :  *) 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

*) 

^EXECUTION  PROCEDURE:  *) 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

*) 

^PROCESSING  DESCRIPTION:  *) 

WRITE  ENTITY  DEFINITION  TO  A  FILE  *) 

*) 

$ COMMENTS :  *) 

*) 

$ CHANGE  CONTROL:  *) 

ORIGINATED:  08  MAY  1987,  M.  H.  CHOI,  DBMA  *) 

*) 


END  '^INCLUDE  DDENTITY  **********************************************) 
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(*  BEGIN  %INCLUDE  DDENUM  **********************************************) 


PROCEDURE  DDENUM  (  VAR  DDFILE 

CONST  RUNTIME 
CONST  ENTRY 
CONST  PS_ORDER 
VAR  ENTITY_S 
VAR  ENTITY  P 


T_FILE_VARIANT ; 
T_RUN_TIME; 
INTEGER; 
T_PS_ORDER ; 
INTEGER; 


VAR  ENTITY_SIZE  :  INTEGER; 

VAR  ENTITY_POSITION :  INTEGER; 

CONST  ENUM_TABLE_INDEX  :  INTEGER; 

CONST  NO_OF_ENUM  :  INTEGER  ); 
SUBPROGRAM; 

^FUNCTION: 

WRITE  THE  ENUMERATION  ATTRIBUTE  OF  AN  ENTITY  TO  A 
SEQUENTIAL  FILE 


^DESCRIPTION  OF  ARGUMENTS: 


DDFILE 

RUNTIME 

ENTRY 

PS_ORDER 

ENTITY_SIZE 

ENTITY  POSITION 


DESCRIPTION 

DATA  DICTIONARY  SEQUENTIAL  FILE 
CONTAINS  THE  ENTITY  DEFINITION 
ENTRY  ORDER  IN  THE  DEFINITION 
LIST  OF  PHYSICAL  SCHEMA  ORDER 
NUMBER  OF  RECORDS  IN  THE  DEFINITION 
FIRST  RECORD  OF  THE  DEFINITION 


^COMMONS : 

^ENVIRONMENT : 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 

^PROCESSING  DESCRIPTION: 

WRITE  BASIC  DEFINITION 
OBTAIN  THE  NUMBER  OF  ENUMERATION  VALUES 
OBTAIN  THE  STARTING  POSITION  OF  ENUMERATION  VALUE  TABLE 
LOOP  THROUGH  THE  NUMBER  OF  ENUMERATION  VALUES 
WRITE  THE  ENUMERATION  VALUE  FROM  THE  TABLE 
END  LOOP 

^COMMENTS : 

$ CHANGE  CONTROL: 

ORIGINATED:  17  MARCH  1987,  M.  H.  CHOI,  DBMA 


(*  END  %INCLUDE  DDENUM  ***********************************************) 
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(*  BEGIN  %INCLUDE  DDREPORX  ********************************************) 


(* 

PROCEDURE  DDREPORT  (  VAR 

VAR 

EXTERNAL; 


SUBSCHEMAJCEY 

IRC 


ENTKEY; 
RET_REC  ); 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

c* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

<* 

(* 

(* 

<* 

(* 

(* 


^FUNCTION: 

WRITE  THE  DATA  DICTIONARY  IN  A  CHARACTER  FORM. 


^DESCRIPTION  OF  ARGUMENTS: 
NAME 


SUBSCHEMAJCEY 

IRC 


I/O  DESCRIPTION 

I  INPUT  VALUE  OF  ARBITRARY  SIZE 

0  RETURN  CODE 


^COMMONS : 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 

^PROCESSING  DESCRIPTION: 

SORT  ENTITIES  BY  KIND  NUMBER 
LOOP  THROUGH  THE  LIST  OF  ENTITIES 
REQUEST  ENTITY  DEFINITION 

LOOP  THROUGH  THE  NUMBER  OF  ATTRIBUTES  IN  THE  DEFINITION 
CASE  DATA  TYPE  OF 

IN-ADB  :  DDADB  <  EXTERNAL  SUBPROGRAM  ) 

IN-ENUM  :  DDENUM  (  EXTERNAL  SUBPROGRAM  ) 

IN-CL  :  DDCL  (  EXTERNAL  SUBPROGRAM  ) 

IN-ARRAY 


END  CASE 
END  LOOP 
END  LOOP 


DDARRAY  (  EXTERNAL  SUBPROGRAM  ) 


$ COMMENTS : 

$ CHANGE  CONTROL: 

ORIGINATED:  23  MARCH  1987,  M.  H.  CHOI,  DBMA 


*) 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 


(*  END  XINCLUDE  DDREPORT  **********************************************) 


3-294 


Cl  PS560240032U 
April  1990 


(*  BEGIN  %INCLUDE  DDSTRUC 
(* 

PROCEDURE  DDSTRUC 


< 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

<* 


VAR 

CONST 

VAR 

VAR 

SUBPROGRAM; 


********************************************* ) 

*) 

T_FILE_VARIANT ; 

:  T_RUN_TIME; 

:  INTEGER; 

:  T_PS_ORDER; 

:  INTEGER; 

INTEGER  ) ; 


VAR  DDFILE 
CONST  RUNTIME  : 

ENTRY  : 

?S_ORDER  : 

£NTITY_SIZE  : 

ENTITY  POSITION: 


^FUNCTION: 

WRITE  THE  STRUCTURE  ATTRIBUTE  OF  AN  ENTITY  TO 
SEQUENTIAL  FILE 

^DESCRIPTION  OF  ARGUMENTS: 


NAME 

DDFILE 

RUNTIME 

ENTRY 

PS_ORDER 

ENTITY_SIZE 

ENTITY  POSITION 


I/O  DESCRIPTION 


I 

I 

I 

I 

0 

0 


DATA  DICTIONARY  SEQUENTIAL  FILE 
CONTAINS  THE  ENTITY  DEFINITION 
ENTRY  ORDER  IN  THE  DEFINITION 
LIST  OF  PHYSICAL  SCHEMA  ORDER 
NUMBER  OF  RECORDS  IN  THE  DEFINITION 
FIRST  RECORD  OF  THE  DEFINITION 


$ COMMONS : 


^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 
HARDWARE  SYSTEM:  IBM 


(SEGMENT  SUBPROGRAM) 
360/370/4341/4381 


^EXECUTION  PROCEDURE: 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 
^PROCESSING  DESCRIPTION: 

$ COMMENTS: 

^CHANGE  CONTROL: 

ORIGINATED:  15  JANUARY  1988,  M.  H.  CHOI,  DBMA 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 


(*  2ND  %INCLUDE  DDSTRUC  ***********************************************) 
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(* 

BEGIN  %INCLUDE  DDWRITE 

********************************************) 

(* 

*) 

PROCEDURE  DDWRITE  (  CONST 

RUNTIME  :  T_RUN_TIME; 

VAR 

DDFILE  :  T_FILE_VARIANT ; 

VAR 

DDINX  :  T_INX_FILE; 

VAR 

ENTITY_POSITION:  INTEGER  ); 

SUBPROGRAM; 

<* 

*) 

(* 

^FUNCTION: 

*) 

(* 

WRITE  THE  ENTITY 

DEFINITIONS  TO  A  SEQUENTIAL  FILE 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME 

I/O 

DESCRIPTION 

*) 

(* 

DDFILE 

I 

DATA  DICTIONARY  SEQUENTIAL  FILE 

*) 

(* 

RUNTIME 

I 

CONTAINS  THE  ENTITY  DEFINITION 

*) 

(* 

ENTRY 

I 

ENTRY  ORDER  IN  THE  DEFINITION 

*) 

(* 

PS_ORDER 

I 

LIST  OF  PHYSICAL  SCHEMA  ORDER 

*) 

(* 

ENTITY_SIZE 

0 

NUMBER  OF  RECORDS  IN  THE  DEFINITION 

*) 

(* 

ENTITY_POSITION 

0 

FIRST  RECORD  OF  THE  DEFINITION 

*) 

(* 

*) 

(* 

^COMMONS : 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

(SEGMENT  SUBPROGRAM) 

*) 

(* 

HARDWARE  SYSTEM: 

IBM 

360/370/4341/4381 

*) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  WRITE  BASIC  RECORD  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  ORIGINATED:  08  MAY  1987,  M,  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  %INCLUDE  DDWRITE  **********************************************) 
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(*  %INCLUDE  DEFADD  *) 

(**) 

PROCEDURE  DEFADD (VAR  IRC 

VAR  IDENTIFIER 
VAR  KIND 

VAR  REFEREHCEJCEY 


SUBPROGRAM; 

(**) 


RET_REC ; 
T_NAME; 
INTEGER; 
ENTKEY) ; 


<*- 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

<* 

<* 

(* 


^FUNCTION: 

BATCH  INTERFACE  ROUTINE  THAT  ADDS  AN  UNRESOLVED  ENTITY 
REFERENCE  TO  THE  LIST  OF  BACKPATCH  ENTITIES. 

^DESCRIPTION  OF  ARGUMENTS: 

NAME 

IRC 

IDENTIFIER 
KIND 

REFERENCE  KEY 


$ COMMONS : 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT 
^PROCESSING  DESCRIPTION: 

PERFORM  INITIALIZATIONS . 

DETERMINE  IF  ANY  BACKPATCH  ENTITIES  EXIST  IN  THE  MODEL. 

IF  NO  BACKPATCH  ENTITIES  EXIST,  CREATE  ONE. 

IF  BACKPATCH  ENTITIES  EXIST,  DETERMINE  IF  ONE  HAS  THE  SAME 
NAME  OR  KIND  AS  THE  ENTITY  INPUT. 

IF  A  BACKPATCH  ENTITY  HAS  THE  SAME  NAME  OR  KIND,  THEN  ADD  A 
REFERENCE  AS  A  CONSTITUENT  OF  THAT  BACKPATCH  ENTITY. 

IF  NO  EXISTING  BACKPATCH  ENTITY  HAS  THE  SAME  NAME  OR  KIND, 
THEN  CREATE  A  NEW  BACKPATCH  ENTITY. 

^COMMENTS: 


I/O  DESCRIPTION 

0  INTERNAL  RETURN  CODE 
I  NAME  OF  ENTITY  OR  DEFINED  TYPE 
I  KIND  NUMBER  OF  ENTITY 
I  KEY  OF  "ENTITY"  WITH  UNRESOLVED 
REFERENCE 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  04/22/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

<*  *) 

(*END - *) 

(*  END  %INCLUDE  DEFADD  *) 
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(*  %INCLUDE  DEFARR  *) 

(**) 

PROCEDURE  DEFARR(VAR  IRC  :  RET_REC; 

VAR  ENT_KIND  :  INTEGER; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  TOKEN  :  T_TOKEN ; 

VAR  TOKEN_VALUE  :  T_TOKEN_VALUE ; 

VAR  TOKEN_LOCATION  :  INTEGER; 

VAR  TOKEN_LENGTH  :  INTEGER; 

VAR  REP0RT1  :  TEXT); 

SUBPROGRAM; 

<**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  BATCH  INTERFACE  ROUTINE  THAT  PROCESSES  AN  ARRAY  DEFINITION. 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 

(*  NAME  I/O  DESCRIPTION 

(*  IRC  0  INTERNAL  RETURN  CODE 

(*  ENTJCIND  I  THE  KIND  OF  ENTITY  BEING  CONSTRUCTED 

(*  TRANS_STACK  I/O  TRANSACTION  STACK 

(*  TOKEN  I/O  TOKEN  FROM  BATCH  INPUT 

(*  TOKEN_VALUE  I/O  TOKEN  VALUE  FROM  BATCH  INPUT 

(*  TOKEN_LOCATION  I/O  LOCATION  OF  TOKEN  IN  INPUT  LINE 

(*  TOKEN_LENGTH  I/O  LENGTH  OF  TOKEN 

(*  TEXT  I/O  OUTPUT  FILE 

(* 

(*  $ COMMONS : 

<* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT 

(* 

(*  '^PROCESSING  DESCRIPTION: 

(* 

(*  INITIALIZE  VARIABLES 

(*  GET  ARRAY  LOWER  BOUND  AND  VERIFY  RANGE 

(*  GET  ARRAY  UPPER  BOUND  AND  VERIFY  RANGE 

(*  PUSH  ARRAY  TRANSACTION  ONTO  STACK 

(*  GET  THE  ARRAY  TYPE 

(*  IF  THE  ARRAY  TYPE  IS  BASIC  TYPE  THEN 

(*  CREATE  BASIC  CONSTITUENT 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  ELSE  *) 

(*  IF  THE  ARRAY  TYPE  IS  DEFINED  TYPE  THEN  *) 

(*  CREATE  DEFINED  TYPE  CONSTITUENT  *) 

(*  PRINT  ERRORS  AS  APPROPRIATE  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  03/20/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - - - *) 

(*  END  %INCLUDE  DEFARR  *) 
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(*  ^INCLUDE 
(**> 

PROCEDURE 


DEFATT  *) 

DEFATT(VAR  IRC 

VAR  TRANS_STACK 
VAR  TOKEN 
VAR  TOKEN_VALUE 
VAR  TOKEN_LOCATION 
VAR  TOKEN_LENGTH 
VAR  FIELDTYPE 
VAR  SUBSCHEMA_FLAG 
VAR  SUB_ENT_HEAD 
VAR  SUB_ENT_LIST 
VAR  CLASS_FLAG 
VAR  CLS_ENT_HEAD 
VAR  CLS_ENT_LIST 
VAR  REP0RT1 


SUBPROGRAM; 


RET_REC ; 

TRANSPTR; 

TJTOKEN; 

T_TOKEN_VALUE; 

INTEGER; 

INTEGER; 

T_FIELDTYPE; 

BOOLEAN; 

ENTITY_LIST_PTR; 

ENTITY_LIST_PTR; 

BOOLEAN; 

ENTITY_LIST_PTR ; 
ENTITY_LIST_PTR; 
TEXT); 


(**) 

(*— 

— 

-*) 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

BATCH  INTERFACE  ROUTINE  THAT  PROCESSES  AN  ATTRIBUTE 

*) 

(* 

DEFINITION. 

*) 

<* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

(  * 

NAME 

I/O 

DESCRIPTION 

*) 
*  \ 

(* 

IRC 

0 

INTERNAL  RETURN  CODE 

*) 

(* 

TRANS_STACK 

I/O 

TRANSACTION  STACK 

*) 

(* 

TOKEN 

I/O 

TOKEN  FROM  BATCH  INPUT 

*) 

(* 

TOKEN_VALUE 

I/O 

TOKEN  VALUE  FROM  BATCH  INPUT 

*) 

<* 

TOKEN_LOCATION 

I/O 

LOCATION  OF  TOKEN  IN  INPUT  LINE 

*) 

(* 

token_length 

I/O 

LENGTH  OF  TOKEN 

*) 

(* 

FIELDTYPE 

I/O 

TYPE  OF  ATTRIBUTE  (ENTITY  OR  GLOBAL) 

*) 

(* 

SUBSCHEMA_FLAG 

I/O 

INDICATES  IF  ENTITIES  ARE  DEFINED  WITHIN 

*) 

(* 

THE  SUBSCHEMA 

*) 

(* 

SUB  ENT  HEAD 

I/O 

POINTS  TO  LIST  OF  SUBSCHEMA  ENTITIES 

*) 

(* 

SUB_ENT_LIST 

I/O 

POINTS  TO  CURRENT  ENTITY  IN  THE  LIST 

OF 

*) 

(* 

SUBSCHEMA  ENTITIES 

*> 

(* 

CLASS_FLAG 

I/O 

INDICATES  IF  ENTITIES  ARE  DEFINED  WITHIN 

*) 

(* 

THE  CLASS 

*) 

(* 

CLS_ENT_HEAD 

I/O 

POINTS  TO  THE  LIST  OF  CLASS  ENTITIES 

*) 

(* 

CLS_ENT_LIST 

I/O 

POINTS  TO  CURRENT  ENTITY  IN  THE  LIST 

OF 

*) 

(* 

CLASS  ENTITIES 

*) 

(* 

REP0RT1 

I/O 

OUTPUT  FILE 

*) 

(* 

*) 

(* 

^COMMONS : 

*) 
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(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INITIALIZE  VARIABLES  *) 

(*  STORE  ATTRIBUTE  NAME  *) 

(*  DETERMINE  IF  THE  ATTRIBUTE  NAME  IS  UNIQUE  *) 

(*  IF  THE  ATTRIBUTE  TYPE  IS  GLOBAL  OR  STRUCTURE,  THEN  WE  WILL  WANT  *) 

(*  A  LIST  OF  ALL  OF  THE  ATTRIBUTES  SO  THAT  WE  CAN  VERIFY  THAT  *) 

(*  THE  ATTRIBUTE  NAME  IS  UNIQUE  AMONG  ALL  MODELED  ATTRIBUTES.  *) 

(*  IF  THE  ATTRIBUTE  TYPE  IS  ENTITY  THEN  WE  WILL  WANT  A  LIST  OF  *) 

(*  ALL  OF  THE  GLOBAL  AND  STRUCTURE  ATTRIBUTES  SO  THAT  WE  CAN  *) 

(*  VERIFY  THAT  THE  ATTRIBUTE  NAME  IS  UNIQUE  AMONG  ALL  MODELED  *) 

(*  GLOBAL  AND  STRUCTURE  ATTRIBUTES.  *) 

(*  VERIFY  THAT  THE  ATTRIBUTE  NAME  IS  UNIQUE  AMONG  THOSE  ATTRIBUTES  *) 
(*  ON  THE  STACK.  *) 

(*  VERIFY  THAT  THE  ATTRIBUTE  NAME  IS  UNIQUE  AMONG  THOSE  ATTRIBUTES  *) 
(*  ALREADY  MODELED.  *) 

(*  IF  THE  ATTRIBUTE  NAME  IS  UNIQUE  THEN  PUT  THE  ATTRIBUTE  DATA  ON-  *) 
(*  TO  THE  STACK  AND  GET  NEXT  TOKEN.  *) 

(*  DETERMINE  IF  ANOTHER  ATTRIBUTE  FOLLOWS  THE  CURRENT  ONE  *) 

(*  (SEPARATED  BY  A  COMMA)  OR  IF  THE  TYPE  DEFINITION  FOR  *) 

(*  THE  ATTRIBUTE (S)  IS  NEXT.  *) 

(*  IF  ANOTHER  ATTRIBUTE  FOLLOWS  THEN  *) 

(*  DEFINE  THE  ATTRIBUTE  *) 

(*  ELSE  *) 

(*  IF  ATTRIBUTE  TYPE  IS  BASIC  TYPE  THEN  *) 

(*  CREATE  BASIC  TYPE  *) 

(*  ELSE  *) 

(*  IF  ATTRIBUTE  TYPE  IS  DEFINED  TYPE  THEN  *) 

(*  CREATE  DEFINED  TYPE  CONSTITUENT  *) 

(*  PRINT  ERRORS  AS  APPROPRIATE  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  REVISED:  30  MARCH  1988  C.  H.  MOHME  DBMA  *) 

(*  MODIFIED  TO  INCORPORATE  ATTRIBUTE  PHYSICAL  POSITION  NUMBER.  *) 

(*  *) 

(*  REVISED:  JANUARY  1988  C.  H.  MOHME  DBMA  *) 
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(*  MODIFIED  TO  INCORPORATE  THE  STRUCTURE  DATA  TYPE  *) 

(*  *) 

(*  ORIGINATED:  03/20/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  DEFATT  *) 
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(*  %INCLUDE  DEFBAS  *) 

(**) 

PROCEDURE  DEFBAS (VAR  IRC  :  RET_REC ; 

VAR  ENT_KIND  :  INTEGER; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  TOKEN  :  T_T0KEN; 

VAR  TOKEN_VALUE  :  T_TOKEN_VALUE ; 

VAR  TOKEN_LOCATION  :  INTEGER; 

VAR  TOKEN_LENGTH  :  INTEGER; 

VAR  REPORT1  :  TEXT); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  BATCH  INTERFACE  ROUTINE  THAT  PROCESSES  A  PRIMITIVE  DATA  *) 

(*  TYPE  DEFINITION.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  ENTJQND  0  THE  KIND  OF  ENTITY  BEING  CONSTRUCTED  *) 

(*  TRANS_STACK  I/O  TRANSACTION  STACK  *) 

(*  TOKEN  I/O  TOKEN  FROM  BATCH  INPUT  *) 

(*  TOKEN_VALUE  I/O  TOKEN  VALUE  FROM  BATCH  INPUT  *) 

(*  TOKENJLOCATION  I/O  TOKEN  VALUE  FROM  BATCH  INPUT  *) 

(*  TOKEN_LENGTH  I/O  TOKEN  VALUE  FROM  BATCH  INPUT  *) 

(*  REPORT1  I/O  OUTPUT  FILE  *) 

<*  ‘  *) 

(*  ^COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INITIALIZE  VARIABLES  *) 

(*  IF  BASIC  TYPE  IS  INTEGER  THEN  *) 

(*  GET  INTEGER  PRECISION  *) 

(*  PUSH  INTEGER  DATA  ONTO  TRANSACTION  STACK  *) 

(*  IF  BASIC  TYPE  IS  REAL  THEN  *) 

(*  GET  REAL  PRECISION  *) 
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(*  PUSH  REAL  DATA  ONTO  TRANSACTION  STACK  *) 

(*  IF  BASIC  TYPE  IS  STRING  THEN  *) 

(*  GET  STRING  PRECISION  *) 

(*  PUSH  STRING  DATA  ONTO  TRANSACTION  STACK  *) 

(*  IF  BASIC  TYPE  IS  LOGICAL  THEN  *) 

(*  PUSH  LOGICAL  DATA  ONTO  TRANSACTION  STACK  *) 

(*  IF  BASIC  TYPE  IS  ARRAY  THEN  *) 

(*  DEFINE  ARRAY  *) 

(*  IF  BASIC  TYPE  IS  POINTER  THEN  *) 

(*  DEFINE  POINTER  *) 

(*  WRITE  APPROPRIATE  ERROR  MESSAGES  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  03/20/87  C.  H.  MOHME  DBM  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  /.INCLUDE  DEFBAS  *) 
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(*  ^INCLUDE 
(**) 

PROCEDURE 


DEFCLS  *) 


DEFCLS (VAR  IRC 

RET_REC ; 

VAR  TRANS_STACK 

TRANS PTR; 

VAR  TOKEN 

T_TOKEN ; 

VAR  TOKEN_VALUE 

T_TOKEN_VALUE ; 

VAR  TOKEN_LO CATION 

INTEGER; 

VAR  TOKEN_LENGTH 

INTEGER; 

VAR  SUBS  CHEMA_FLAG 

BOOLEAN; 

VAR  SUB_ENT_HEAD 

ENTITY_LI ST_PTR ; 

VAR  SUB_ENT_LIST 

ENTITY_LIST_PTR; 

VAR  CLASS_FLAG 

BOOLEAN; 

VAR  CLS_ENT_HEAD 

ENTITYJLI ST_PTR ; 

VAR  CLS_ENT_LIST 

ENTITY_LIST_PTR; 

VAR  REPORTI 

TEXT); 

SUBPROGRAM; 


(**) 

(*— 

._*) 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

BATCH  INTERFACE  ROUTINE  THAT  PROCESSES  A  CLASS  DEFINITION. 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME 

I/O 

DESCRIPTION 

*) 

(* 

IRC 

0 

INTERNAL  RETURN  CODE 

) 

*) 

(* 

TRANS_STACK 

I/O 

TRANSACTION  STACK 

*) 

(* 

TOKEN 

I/O 

TOKEN  FROM  BATCH  INPUT 

*) 

(* 

TOKSNVALUE 

I/O 

TOKEN  VALUE  FROM  BATCH  INPUT 

*) 

(* 

TOKEN_LOCATION 

I/O 

LOCATION  OF  TOKEN  IN  INPUT  LINE 

*> 

(* 

TOKEN_LENGTH 

I/O 

LENGTH  OF  TOKEN 

*) 

(* 

SUBSCHEMA_FLAG 

I/O 

INDICATES  IF  ENTITIES  OR  CLASSES 

ARE 

*) 

(* 

DEFINED  WITHIN  A  SUBSCHEMA 

*> 

<* 

SUB_ENT_HEAD 

I/O 

POINTS  TO  LIST  OF  SUBSCHEMA  ENTITIES 

*) 

<* 

SUB  ENT  LIST 

I/O 

POINTS  TO  CURRENT  ENTITY  IN  LIST 

OF 

*) 

(* 

SUBSCHEMA  ENTITIES 

*) 

(* 

CLASS_FLAG 

I/O 

INDICATES  IF  ENTITIES  OR  CLASSES 

ARE 

*) 

(* 

DEFINED  WITHIN  A  CLASS 

*) 

(* 

CLS_ENT_HEAD 

I/O 

POINTS  TO  LIST  OF  CLASS  ENTITIES 

*) 

<* 

CLS_ENT_LIST 

I/O 

POINTS  TO  CURRENT  ENTITY  IN  LIST 

OF 

*) 

(* 

CLASS  ENTITIES 

*) 

(* 

REPORTI 

I/O 

OUTPUT  FILE 

*) 

(* 

*) 

(* 

$ COMMONS : 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM 

PASCAL 

*) 
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(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INITIALIZE  VARIABLES  *) 

(*  GET  CLASS  NAME  AND  KIND  NUMBER  *) 

(*  VERIFY  UNIQUENESS  OF  CLASS  NAME  AND  KIND  NUMBER  *) 

(*  IF  THE  NEXT  TOKEN  IS  AN  IDENTIFIER  OR  AN  INTEGER,  THEN  WE  KNOW  *) 

(*  THAT  WE  WILL  BE  GETTING  A  LIST  OF  ENTITIES  AND  CLASSES  THAT  *) 

(*  ARE  TO  BE  MEMBERS  OF  THE  CLASS.  IF  THE  SUBSCHEMA  FLAG  OR  *) 

(*  CLASS  FLAG  IS  SET,  THEN  ADD  THE  CLASS  NAME  TO  THE  APPROPRIATE  *) 

(*  LIST(S) .  PUSH  THE  CLASS  NAME  AND  KIND  NUMBER  ONTO  THE  PRO-  *) 

(*  CESSING  STACK.  *) 

(*  DETERMINE  IF  THE  ENTITY  OR  CLASS  EXISTS  *) 

(*  IF  WE  HAVE  AN  ENTITY  OR  CLASS  KEY  THEN  WE  VERIFY  THAT  THE  *) 

(*  ENTITY  OR  CLASS  IS  NOT  ALREADY  A  MEMBER  OF  THE  CLASS.  IF  *) 

(*  IT  IS  NOT  A  MEMBER,  WE  ATTACH  THE  KEY  TO  THE  LIST  AND  PUSH  *) 

(*  A  TRANSACTION  ONTO  THE  STACK.  *) 

(*  IF  THE  ENTITY  OR  CLASS  CONSTITUENT  DOES  NOT  ALREADY  EXIST,  *) 

(*  CREATE  AN  UNRESOLVED  ENTITY  AND  MAKE  IT  A  CONSTITUENT  OF  *) 

(*  THE  CLASS.  IF  THE  ENTITY  OR  CLASS  CONSTITUENT  IS  LATER  *) 

(*  CREATED,  THEN  IT  WILL  REPLACE  THE  UNRESOLVED  ENTITY  IN  THE  *) 

(*  CLASS  CONSTITUENT  LIST.  *) 

(*  IF  WE  HAVE  READ  IN  ALL  OF  THE  ENTITY  AND  CLASS  NAMES,  WE  PUSH  *) 

(*  THE  FINAL  CLASS  TRANSACTION  ONTO  THE  STACK  AND  PROCESS  THE  *) 

(*  TRANSACTION  STACK.  *) 

(*  IF  WE  HAVE  ENCOUNTERED  AN  ENTITY  OR  CLASS  DEFINITION,  THEN  WE  *) 
(*  SET  A  FLAG  TO  INDICATE  THAT  AFTER  MODELING  THESE  ENTITIES  *) 

(*  AND  CLASSES,  WE  MUST  THEN  MODEL  THE  CLASS.  *) 

(*  ADD  THE  CLASS  TO  THE  SUBSCHEMA  AND  CLASS  LIST,  AS  NECESSARY  *) 

(*  WRITE  APPROPRIATE  ERROR  MESSAGES  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  03/20/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  XINCLUDE  DEFCLS  *) 
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(*  %INCLUDE  DEFDEF  *) 

(**) 

PROCEDURE  DEFDEF(VAR  IRC  :  RET_REC ; 

VAR  TRANS JSTACK  :  TRANSPTR; 

VAR  TOKEN  :  T_TOKEN ; 

VAR  TOKEN_VALUE  :  T_TOKEN_VALUE ; 

VAR  TOKEN_LOCATION  :  INTEGER; 

VAR  TOKEN_LENGTH  :  INTEGER; 

VAR  REPORT1  :  TEXT); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  BATCH  INTERFACE  ROUTINE  THAT  PROCESSES  A  DEFINED  TYPE  *) 

(*  REFERENCE.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 


(*  IRC  0  INTERNAL  RETURN  CODE  *) 
(*  TRANS_STACK  I/O  TRANSACTION  STACK  *) 
(*  TOKEN  I/O  TOKEN  FROM  BATCH  INPUT  *) 
(*  TOKEN_VALUE  I/O  TOKEN  VALUE  FROM  BATCH  INPUT  *) 
(*  TOKEN.LOCATION  I  LOCATION  OF  TOKEN  IN  INPUT  LINE  *) 
(*  TOKEN.LENGTH  i  LENGTH  OF  TOKEN  *) 


(*  REPORT1  I/O  OUTPUT  FILE  *) 

(*  *) 

(*  $ COMMONS :  *' 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  3 60/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

C*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INITIALIZE  THE  VARIABLES  *) 

(*  DETERMINE  IF  THE  DEFINED  TYPE  EXISTS  *) 

(*  IF  DEFINED  TYPE  EXISTS  THEN  PUT  DEFINED  TYPE  TRANSACTION  ONTO  *) 

(*  THE  TRANSACTION  STACK  *) 

(*  BUILD  POINTER  REFERENCING  EXISTING  ENTITY  OR  CLASS  OR  BUILD  *) 

(*  UNRESOLVED  ENTITY.  *) 

(*  WRITE  APPROPRIATE  ERROR  MESSAGES  *) 

<*  *) 
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(*  COMMENTS: 

(* 

(*  $ CHANGE  CONTROL: 

(* 

<*  ORIGINATED:  03/20/87  C.  H.  MOHME 

(* 

(* - 

(* 

(*END - 

(*  END  ^INCLUDE  DEFDEF  *) 


*) 

*> 

*) 

*) 

DBMA  *) 

*) 

- *) 

*) 

- *) 
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(*  %INCLUDE  DEFENM  *) 

(**) 

PROCEDURE  DEFENM(VAR  IRC  :  RET_REC ; 

VAR  ENTJCIND  :  INTEGER; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  TOKEN  :  T_TOKEN ; 

VAR  TOKEN_VALUE  .  :  T_TOKEN_VALUE ; 

VAR  TOKENJLOCATION  :  INTEGER; 

VAR  TOKEN_LENGTH  :  INTEGER; 

VAR  REP0RT1  :  TEXT); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  BATCH  INTERFACE  ROUTINE  THAT  PROCESSES  AN  ENUMERATION  *) 

(*  DEFINITION.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 


(*  ENTJCIND  I  THE  KIND  OF  ENTITY  BEING  CONSTRUCTED  *) 
(*  TRANS_STACK  I/O  TRANSACTION  STACK  *) 
(*  TOKEN  I/O  TOKEN  FROM  BATCH  INPUT  *) 
(*  TOKEN.VALUE  I/O  TOKEN  VALUE  FROM  BATCH  INPUT  *) 
(*  TOKEN_LOCATION  I/O  LOCATION  OF  TOKEN  IN  INPUT  LINE  *) 
(*  TOKEN JCENGTH  I/O  LENGTH  OF  TOKEN  *) 


(*  REP0RT1  I/O  OUTPUT  FILE  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INITIALIZE  VARIABLES  *) 

(*  PUSH  ENUMERATION  TRANSACTION  ONTO  THE  STACK  *) 

(*  GET  EACH  ENUMERATION  ITEM  *) 


(*  VERIFY  THE  UNIQUENESS  OF  EACH  ENUMERATION  ITEM  NAME  AMONG  THE  *) 
(*  ENTITIES  CURRENTLY  MODELED  AND  THOSE  ON  THE  STACK  *) 
(*  IF  THE  ENUMERATION  ITEM  NAME  IS  UNIQUE  THEN  PUSH  A  TRANSACTION  *) 
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(*  ONTO  THE  STACK  *) 

(*  WRITE  APPROPRIATE  ERROR  MESSAGES  *) 

(*  *) 

(*  $ COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  03/20/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  DEFENM  *) 
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(*  %INCLUDE  DEFENT  *) 
<**) 


PROCEDURE  DEFENT (VAR  IRC 

RET_REC ; 

VAR 

TRANS. 

.STACK 

TRANSPTR; 

VAR 

TOKEN 

T_TOKEN ; 

VAR 

TOKEN_VALUE 

T_TOKEN_VALUE ; 

VAR 

TOKEN 

.LOCATION 

INTEGER; 

VAR 

TOKEN_LENGTH 

INTEGER; 

VAR 

SUBSCHEMA_FLAG 

BOOLEAN; 

VAR 

SUB_ENT_HEAD 

ENTITY_LIST_PTR; 

VAR 

SUB_ENT_LIST 

ENTITY_LIST_PTR; 

VAR 

CLASS. 

.FLAG 

BOOLEAN; 

VAR 

CLS_ENT_HEAD 

ENTITY_LIST_PTR; 

VAR 

CLS_ENT_LIST 

ENTITY_LI ST_PTR ; 

VAR 

REP0RT1 

TEXT); 

SUBPROGRAM; 

<**) 

(*— 

— 

— 

•*) 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

BATCH  INTERFACE  ROUTINE  THAT 

PROCESSES  AN  ENTITY  DEFINITION. 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME 

I/O 

DESCRIPTION 

*) 

(* 

IRC 

0 

INTERNAL 

RETURN  CODE 

) 

*) 

(* 

TRANS_STACK 

I/O 

TRANSACTION  STACK 

*) 

(* 

TOKEN 

I/O 

TOKEN  FROM  BATCH  INPUT 

*> 

(* 

TOKEN_VALUE 

I/O 

TOKEN  VALUE  FROM  BATCH  INPUT 

*) 

(* 

TOKEN_LOCATION  I/O 

LOCATION  OF  TOKEN  IN  INPUT  LINE 

*) 

(* 

TOKEN_LENGTH 

I/O 

LENGTH  OF  TOKEN 

*) 

(* 

SUBSCHEMA_FLAG  I/O 

INDICATES 

IF  ENTITIES  ARE  DEFINED 

WITHIN 

*) 

(* 

THE  SUBSCHEMA 

*) 

<* 

SUB_ENT_HEAD 

I/O 

POINTS  TO 

LIST  OF  SUBSCHEMA  ENTITIES 

*) 

(* 

SUB_ENT_LIST 

I/O 

POINTS  TO 

CURRENT  ENTITY  IN  LIST 

OF 

*) 

(* 

SUBSCHEMA  ENTITIES 

*) 

(* 

CLASS_FLAG 

I/O 

INDICATES 

IF  ENTITIES  ARE  DEFINED 

WITHIN 

*) 

(* 

THE  CLASS 

*) 

(* 

CLS_ENT_HEAD 

I/O 

POINTS  TO 

LIST  OF  CLASS  ENTITIES 

*) 

(* 

CLS_ENT_LIST 

I/O 

POINTS  TO 

CURRENT  ENTITY  IN  LIST 

OF 

*) 

(* 

CLASS  ENTITIES 

*) 

(* 

REP0RT1 

I/O 

OUTPUT  FILE 

*) 

(* 

*> 

(* 

^COMMONS : 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 
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(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

<*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INITIALIZE  VARIABLES  *) 

(*  GET  THE  ENTITY  NAME  AND  KIND  NUMBER  *) 

(*  VERIFY  THE  UNIQUENESS  OF  THE  ENTITY  NAME  AND  KIND  NUMBER  AMONG  *) 

(*  MODELED  ENTITIES  AND  THOSE  ON  THE  STACK  *) 

(*  IF  THE  ENTITY  NAME  AND  KIND  NUMBER  ARE  UNIQUE  THEN  CHECK  IF  THE  *) 
(*  SUBSCHEMA  FLAG  OR  CLASS  FLAG  ARE  SET.  IF  SO,  ADD  THE  ENTITY  *) 

(*  NAME  TO  THE  APPROPRIATE  LIST(S).  PUSH  ENTITY  TRANSACTION  ON-  *) 

(*  TO  THE  STACK.  *) 

(*  DEFINE  EACH  ATTRIBUTE  OF  THE  ENTITY  *) 

(*  WHEN  THE  END  OF  THE  ENTITY  IS  ENCOUNTERED,  THEN  PUSH  FINAL  *) 

(*  ENTITY  TRANSACTION  ONTO  THE  TRANSACTION  STACK  AND  PROCESS  *) 

(*  THE  STACK.  *) 

(*  WRITE  ERROR  MESSAGES  AS  APPROPRIATE  *) 

(*  *) 

(*  $ COMMENTS :  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  03/20/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  7.INCLUDE  DEFENT  *) 
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(*  %INCLUDE  DEFGBL  *) 

(**) 

PROCEDURE  DEFGBL (VAR  IRC 

VAR  TRANS_STACK 
VAR  TOKEN 
VAR  TOKEN_VALUE 
VAR  TOKEN_LOCATI ON 
VAR  TOKEN_LENGTH 
VAR  SUBSCHEMA_FLAG 
VAR  SUB_ENT_HEAD 
VAR  SUB_ENT_LIST 
VAR  CLASS_FLAG 
VAR  CLS_ENT_HEAD 
VAR  CLS_ENT_LIST 
VAR  REPORT1 

SUBPROGRAM; 

(**) 

(* - 


RET_REC; 

TRANSPTR; 

T_TOKEN ; 
T_TOKEN_VALUE ; 
INTEGER; 

INTEGER; 

BOOLEAN; 

ENTITY_LIST_PTR; 

ENTITY_LIST_PTR; 

BOOLEAN; 

ENTITY_LIST_PTR; 

ENTITY_LIST_PTR; 

TEXT); 


$ FUNCTION: 

BATCH  INTERFACE  ROUTINE  THAT  PROCESSES  A  GLOBAL  ATTRIBUTE 
DEFINITION. 


^DESCRIPTION  OF  ARGUMENTS: 


DESCRIPTION 


IRC  0 

TRANSJ5TACK  I/O 

TOKEN  I/O 

TOKEN.VALUE  I/O 

TOKEN.LOCATION  I/O 
TOKENJL.ENGTH  I/O 

SUBSCHEMA  FLAG  I/O 


SUB_ENT_HEAD 

SUB_ENT_LIST 

CIiASS_FLAG 

CLS_ENT_HEAD 

CLS_ENT_LIST 

REPORT1 


INTERNAL  RETURN  CODE 
TRANSACTION  STACK 
TOKEN  FROM  BATCH  INPUT 
TOKEN  VALUE  FROM  BATCH  INPUT 
LOCATION  OF  TOKEN  IN  INPUT  LINE 
LENGTH  OF  TOKEN 

INDICATES  IF  ENTITIES  ARE  DEFINED  WITHIN 
THE  SUBSCHEMA 

POINTS  TO  LIST  OF  SUBSCHEMA  ENTITIES 
POINTS  TO  CURRENT  ENTITY  IN  LIST  OF 
SUBSCHEMA  ENTITIES 

INDICATES  IF  ENTITIES  ARE  DEFINED  WITHIN 
THE  CLASS 

POINTS  TO  LIST  OF  CLASS  ENTITIES 
POINTS  TO  CURRENT  ENTITY  IN  LIST  OF 
CLASS  ENTITIES 
OUTPUT  FILE 


^COMMONS: 


^ENVIRONMENT: 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  PERFORM  INITIALIZATIONS  *) 

(*  GET  GLOBAL  ATTRIBUTE  NAME  *) 

(*  PUSH  INITIAL  GLOBAL  ATTRIBUTE  TRANSACTION  ONTO  THE  STACK  *) 

C*  DEFINE  THE  GLOBAL  ATTRIBUTE  *) 

(*  IF  GLOBAL  ATTRIBUTE  ACCEPTED,  THEN  PUSH  FINAL  GLOBAL  ATTRIBUTE  *) 

(*  TRANSACTION  ONTO  THE  STACK  AND  PROCESS.  IF  THE  GLOBAL  ATTRI-  *) 

(*  BUTE  NOT  ACCEPTED  THEN  RECOVER.  *) 

(*  WRITE  APPROPRIATE  ERROR  MESSAGES  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  05/15/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

<*END - *) 

(*  END  %INCLUDE  DEFGBL  *) 
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(*  %INCLUDE  DEFPRE  *) 

(**) 

PROCEDURE  DEFPRE (VAR  IRC 

VAR  ENTJCIND 
VAR  TRANS_STACK 
VAR  TOKEN 
VAR  TOKEN_VALUE 
VAR  TOKEN_LOCATION 
VAR  TOKEN_LENGTH 
VAR  DATA 
VAR  PRECISION 
VAR  REPORT1 

SUBPROGRAM; 

(**) 

(* - 


RET_REC ; 

INTEGER; 

TRANSPTR; 

T_T0KEN; 

T_TOKEN_VALUE ; 

INTEGER; 

INTEGER; 

TRANSACTION; 

INTEGER; 

TEXT); 


*) 

$ FUNCTION:  *) 

BATCH  INTERFACE  ROUTINE  THAT  PROCESSES  AN  INTEGER  PRECISION,*) 

REAL  PRECISION,  OR  STRING  LENGTH.  *) 

*) 

^DESCRIPTION  OF  ARGUMENTS:  *) 


(* 

(* 

(* 

NAME 

I/O 

DESCRIPTION 

*) 

*) 

*) 

IRC 

0 

INTERNAL  RETURN  CODE 

<* 

ENTJCIND 

I 

THE  KIND  OF  ENTITY  BEING  CONSTRUCTED 

*) 

(* 

TRANS_STACK 

I/O 

TRANSACTION  STACK 

*) 

(* 

TOKEN 

I/O 

TOKEN  FROM  BATCH  INPUT 

*) 

(* 

TOKEN_VALUE 

I/O 

TOKEN  VALUE  FROM  BATCH  INPUT 

*) 

(* 

TOKEN JLOCATIONI/O 

LOCATION  OF  TOKEN  IN  INPUT  LINE 

*) 

(* 

TOKEN.LENGTH 

I/O 

LENGTH  OF  TOKEN 

*) 

(* 

DATA 

I/O 

CONTAINS  TRANSACTION  INFORMATION 

*) 

(* 

PRECISION 

0 

INTEGER  PRECISION,  REAL  PRECISION,  OR 

*) 

(* 

STRING  LENGTH 

*) 

(* 

REPORT1 

I/O 

OUTPUT  FILE 

*) 

<* 

*) 

(* 

$ COMMONS: 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM 

PASCAL 

*) 

<* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

INTERNAL  PROCEDURE 

FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION 

: 

*) 

(* 

*) 

(* 

INITIALIZE  VARIABLES 

*) 
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(*  GET  THE  PRECISION,  IF  PRESENT  *) 

(*  IF  THE  PRECISION  IS  SPECIFIED,  THEN  VERIFY  THAT  IT  IS  IN  THE  *) 

(*  PROPER  RANGE.  *) 

(*  IF  THE  PRECISION  IS  NOT  SPECIFIED,  THEN  ASSIGN  THE  DEFAULT  *) 

(*  PRECISION.  *) 

(*  WRITE  APPROPRIATE  ERROR  MESSAGES  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  03/20/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  ^INCLUDE  DEFPRE  *) 
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(*  %INCLUDE  DEFPTR  *) 

(**) 

PROCEDURE  DEFPTR(VAR  IRC  :  RET_REC; 

VAR  ENTJQND  :  INTEGER; 

VAR  TRANSJ5TACK  :  TRANSPTR; 

VAR  TOKEN  :  T_T0KEN; 

VAR  TOKEN_VALUE  :  T_TOKEN_VALUE ; 

VAR  TOKEN_LO CATION  :  INTEGER; 

VAR  TOKEN.LENGTH  :  INTEGER; 

VAR  REPORT 1  :  TEXT); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  BATCH  INTERFACE  ROUTINE  THAT  PROCESSES  A  POINTER  DEFINITION.*) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  ENTJCIND  I  THE  KIND  OF  ENTITY  BEING  CONSTRUCTED  *) 

(*  TRANSJ3TACK  I/O  TRANSACTION  STACK  *) 

(*  TOKEN  I/O  TOKEN  FROM  BATCH  INPUT  *) 

(*  TOKEN_VALUE  I/O  TOKEN  VALUE  FROM  BATCH  INPUT  *) 

(*  TOKENJjOCATION  I/O  TOKEN  VALUE  FROM  BATCH  INPUT  *) 

(*  TOKEN.LENGTH  I/O  TOKEN  VALUE  FROM  BATCH  INPUT  *) 

(*  REPORT1  I/O  OUTPUT  FILE  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INITIALIZE  VARIABLES  *) 

(*  PUSH  INITIAL  POINTER  TRANSACTION  ONTO  THE  TRANSACTION  STACK  *) 

(*  GET  EACH  POINTER  CONSTITUENT  NAME  OR  KIND  NUMBER.  *) 

(*  DETERMINE  IF  THE  ENTITY  OR  CLASS  EXISTS  *) 

(*  VERIFY  THAT  THE  ENTITY  OR  CLASS  IS  NOT  ALREADY  A  CONSTITUENT.  *) 

(*  IF  IT  IS  NOT,  THEN  PUSH  ENTITY  KEY  TRANSACTION  ONTO  THE  *) 

(*  TRANSACTION  STACK.  *) 
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(*  IF  THE  POINTER  REFERENCES  AN  ENTITY  THAT  IS  NOT  DEFINED,  THEN  *) 

(*  CREATE  AN  UNRESOLVED  ENTITY.  IF  THE  UNDEFINED  ENTITY  IS  *) 

(*  LATER  DEFINED,  IT  WILL  REPLACE  THE  UNRESOLVED  ENTITY  IN  THE  *) 

(*  POINTER'S  CONSTITUENT  LIST.  *) 

(*  PUSH  THE  FINAL  POINTER  TRANSACTION  ONTO  THE  TRANSACTION  STACK  *) 
(*  WRITE  APPROPRIATE  ERROR  MESSAGES  *) 

(*  *) 

(*  ^COMMENTS:  *) 

<*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  03/20/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

<*  END  7.INCLUDE  DEFPTR  *) 
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(*  %INCLUDE  DEFQUERY  *) 

(**) 

PROCEDURE  DEFQUERY(VAR  IRC  :  RET_REC; 

VAR  IDENTIFIER  :  T_NAME; 

VAR  KIND  :  INTEGER; 

VAR  DEFINITION_KEY_KIND  :  INTEGER; 

VAR  DEFINITION_KEY  :  ENTKEY) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  BATCH  INTERFACE  ROUTINE  THAT  DETERMINES  IF  A  NEWLY  MODELED  *) 

(*  ENTITY  SATISFIES  ANY  UNRESOLVED  ENTITY  REFERENCES  ON  THE  *) 

(*  BACKPATCH  LIST.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  IDENTIFIER  I  NAME  OF  ENTITY,  CLASS,  OR  DEFINED  TYPE  *) 

C*  KIND  I  KIND  NUMBER  OF  ENTITY  OR  CLASS  *) 

(*  ENTJCIND  I  THE  KIND  OF  ENTITY  (DEFINED  TYPE,  ENTITY  *) 

(*  OR  CLASS)  *) 

(*  DEFINITIONJCEY  I  KEY  OF  "ENTITY"  WITH  UNRESOLVED  *) 

(*  REFERENCE  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INITIALIZE  VARIABLES  *) 

(*  DETERMINE  IF  ANY  BACKPATCH  ENTITIES  EXIST  IN  THE  MODEL  *) 

(*  IF  BACKPATCH  ENTITIES  EXIST,  DETERMINE  IF  ONE  MATCHES  THE  NAME  *) 

(*  OR  KIND  OF  THE  NEWLY  CREATED  ENTITY.  *) 

(*  IF  A  MATCH  HAS  BEEN  FOUND,  THEN  WE  CAN  RESOLVE  EACH  REFERENCE  *) 

(*  OF  THE  BACKPATCH  ENTITY.  *) 

(*  IF  THE  NEWLY  CREATED  ENTITY  IS  A  DEFINED  TYPE,  THEN  WE  REPLACE  *) 
(*  THE  CONSTITUENT  OF  THE  REFERENCE  KEY  WITH  THE  KEY  OF  THE  *) 

(*  NEWLY  DEFINED  ENTITY.  *) 
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(*  IF  THE  REFERENCE  KEY  IS  A  CONSTITUENT  OF  A  CLASS,  THEN  WE  PUT  *) 
(*  THE  KEY  OF  THE  NEWLY  DEFINED  ENTITY  IN  THE  CLASS’  CONSTITU-  *) 

(*  ENT  LIST  IN  PLACE  OF  THE  REFERENCE  KEY.  *) 

(*  IF  THE  REFERENCE  KEY  IS  A  CONSTITUENT  OF  A  SUBSCHEMA,  THEN  WE  *) 

(*  PUT  THE  KEY  OF  THE  NEWLY  DEFINED  ENTITY  IN  THE  SUBSCHEMA'S  *) 

(*  CONSTITUENT  LIST  IN  PLACE  OF  THE  REFERENCE  KEY.  *) 

(*  IF  THE  REFERENCE  KEY  IS  A  CONSTITUENT  OF  A  POINTER,  THEN  WE  *) 

(*  PUT  THE  KEY  OF  THE  NEWLY  DEFINED  ENTITY  IN  THE  POINTER'S  *) 

(*  CONSTITUENT  LIST  IN  PLACE  OF  THE  REFERENCE  KEY.  *) 

(*  IF  THE  NEWLY  DEFINED  ENTITY  IS  NOT  A  DEFINED  TYPE  AND  IF  THE  *) 

(*  REFERENCE  KEY  IS  NOT  A  CONSTITUENT  OF  A  SUBSCHEMA,  CLASS  OR  *) 

(*  POINTER  THEN  WE  BUILD  A  POINTER  (WHICH  REFERENCES  THE  *) 

(*  NEWLY  DEFINED  ENTITY)  AND  MAKE  IT  A  CONSTITUENT  OF  THE  *) 

(*  REFERENCE  KEY.  *) 

(*  DELETE  THE  BACKPATCH  ENTITY  AND  READ  THE  NEXT  ONE  *) 

(*  *) 

(*  $ COMMENTS :  *) 

<*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  04/22/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  /.INCLUDE  DEFQUERY  *) 


3-321 


Cl  PS560240032U 
April  1990 


(*  %INCLUDE  DEFSTC  *) 

(**) 

PROCEDURE  DEFSTC (VAR  IRC  :  RET_REC ; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  TOKEN  :  T_TOKEN ; 

VAR  TOKEN_VALUE  :  T_TOKEN_VALUE ; 

VAR  TOKEN_LOCATION  :  INTEGER; 

VAR  TOKEN_LENGTH  :  INTEGER; 

VAR  SUBS CHEMA_FLAG  :  BOOLEAN; 

VAR  SUB_ENT_HEAD  :  ENTITY_LIST_PTR; 

VAR  SUB_ENT_LIST  :  ENTITY_LIST_PTR; 

VAR  CLASS_FLAG  :  BOOLEAN; 

VAR  CLS_ENT_HEAD  :  ENTITY_LIST_PTR; 

VAR  CLS_ENT_LIST  :  ENTITY_LIST_PTR; 

VAR  REPORT1  :  TEXT); 

SUBPROGRAM; 

(**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  BATCH  INTERFACE  ROUTINE  THAT  PROCESSES  A  STRUCTURE 

(*  DEFINITION. 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 


(* 

(* 

(* 

NAME 

I/O 

DESCRIPTION 

IRC 

0 

INTERNAL  RETURN  CODE 

(* 

TRANS_STACK 

I/O 

TRANSACTION  STACK 

(* 

TOKEN 

I/O 

TOKEN  FROM  BATCH  INPUT 

<* 

TOKEN_VALUE 

I/O 

TOKEN  VALUE  FROM  BATCH  INPUT 

(* 

TOKEN.LOCATION 

I/O 

LOCATION  OF  TOKEN  IN  INPUT  LINE 

(* 

TOKEN_LENGTH 

I/O 

LENGTH  OF  TOKEN 

(* 

SUBSCHEMA_FLAG 

I/O 

INDICATES  IF  ENTITIES  ARE  DEFINED  WITHIN 

(* 

THE  SUBSCHEMA 

(* 

SUB_ENT_HEAD 

I/O 

POINTS  TO  LIST  OF  SUBSCHEMA  ENTITIES 

(* 

SUB_ENT_LIST 

I/O 

POINTS  TO  CURRENT  ENTITY  IN  LIST  OF 

(* 

SUBSCHEMA  ENTITIES 

(* 

CLASS_FLAG 

I/O 

INDICATES  IF  ENTITIES  ARE  DEFINED  WITHIN 

(* 

THE  CLASS 

(* 

CLS_ENT_HEAD 

I/O 

POINTS  TO  LIST  OF  CLASS  ENTITIES 

(* 

CLS_ENT_LIST 

I/O 

POINTS  TO  CURRENT  ENTITY  IN  LIST  OF 

(* 

CLASS  ENTITIES 

(* 

REPORT1 

I/O 

OUTPUT  FILE 

<* 

(*  ^COMMONS: 

(* 

(*  ^ENVIRONMENT: 


■*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 
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(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  PERFORM  INITIALIZATIONS  *) 

(*  PUSH  INITIAL  STRUCTURE  TRANSACTION  ONTO  THE  STACK  *) 

(*  DEFINE  STRUCTURE  ATTRIBUTES  *) 

(*  RECOVER  FROM  ERROR,  AS  NECESSARY  *) 

(*  PUSH  FINAL  STRUCTURE  TRANSACTION  ONTO  THE  STACK  AND  GET  NEXT  *) 

(*  TOKEN  *) 

(*  WRITE  APPROPRIATE  ERROR  MESSAGES  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  05/18/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  DEFSTC  *) 


t 
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(*  %INCLUDE  DEFSUB  *) 

(**) 

PROCEDURE  DEFSUB (VAR  IRC  :  RET_REC ; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  TOKEN  :  TJTOKEN; 

VAR  TOKEN_VALUE  :  T_TOKEN_VALUE ; 
VAR  TOKEN_LO CATION  :  INTEGER; 

VAR  TOKEN_LENGTH  :  INTEGER; 

VAR  SUBSCHEMAJFLAG  :  BOOLEAN; 

VAR  SUB_ENT_HEAD  :  ENTITY_LIST_PTR; 
VAR  SUB_ENT_LIST  :  ENTITY_LIST_PTR ; 
VAR  CLASS_FLAG  :  BOOLEAN; 

VAR  CLS_ENT_HEAD  :  ENTITY_LIST_PTR; 
VAR  CLS_ENT_LIST  :  ENTITY_LIST_PTR; 
VAR  REPORT1  :  TEXT); 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  BATCH  INTERFACE  ROUTINE  THAT  PROCESSES  A  SUBSCHEMA  *) 

(*  DEFINITION.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  TRANSACTION  STACK  *) 

(*  TOKEN  I/O  TOKEN  FROM  BATCH  INPUT  *) 

(*  TOKEN.VALUE  I/O  TOKEN  VALUE  FROM  BATCH  INPUT  *) 

(*  TOKEN_LOCATION  I/O  LOCATION  OF  TOKEN  IN  INPUT  LINE  *) 

(*  TOKENJLENGTH  I/O  LENGTH  OF  TOKEN  *) 

(*  SUBS CHEMA_FLAG  I/O  INDICATES  IF  ENTITIES  ARE  DEFINED  WITHIN  *) 

(*  THE  SUBSCHEMA  *) 

(*  SUB_ENT_HEAD  I/O  POINTS  TO  THE  LIST  OF  SUBSCHEMA  ENTITIES  *) 

(*  SUB_ENT_LIST  I/O  POINTS  TO  THE  CURRENT  ENTITY  IN  THE  LIST  *) 

(*  OF  SUBSCHEMA  ENTITIES  *) 

(*  CLASS_FLAG  I/O  INDICATES  IF  ENTITIES  ARE  DEFINED  WITHIN  *) 

(*  THE  CLASS  *) 

(*  CLS_ENT_HEAD  I/O  POINTS  TO  THE  LIST  OF  CLASS  ENTITIES  *) 

(*  CLS_ENT_LIST  I/O  POINTS  TO  THE  CURRENT  ENTITY  IN  THE  LIST  *) 

(*  OF  CLASS  ENTITIES  *) 

(*  REPORT1  I/O  OUTPUT  FILE  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 
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(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INITIALIZE  VARIABLES  *) 

(*  GET  SUBSCHEMA  NAME  AND  VERIFY  ITS  UNIQUENESS  *) 

(*  IF  SUBSCHEMA  NAME  IS  UNIQUE  THEN  GET  NEXT  MEANINGFUL  TOKEN  *) 

(*  IF  THE  TOKEN  IS  AN  IDENTIFIER  OR  AN  INTEGER,  THEN  WE  KNOW  THAT  *) 

(*  WE  WILL  BE  GETTING  A  LIST  OF  ENTITIES  AND  CLASSES  THAT  ARE  TO  *) 

(*  BE  MEMBERS  OF  THE  SUBSCHEMA.  PUSH  THE  SUBSCHEMA  NAME  ONTO  *) 

(*  THE  PROCESSING  STACK.  *) 

(*  DETERMINE  IF  THE  IDENTIFIER  IS  AN  ENTITY  OR  A  CLASS  *) 

(*  IF  WE  HAVE  AN  ENTITY  OR  CLASS  KEY,  THEN  WE  VERIFY  THAT  IT  IS  *) 

(*  NOT  ALREADY  A  MEMBER  OF  THE  SUBSCHEMA.  IF  IT  IS  NOT,  THEN  *) 

(*  WE  ATTACH  THE  ENTITY  KEY  TO  THE  LIST  AND  PUSH  A  TRANS-  *) 

(*  ACTION  ONTO  THE  TRANSACTION  STACK.  *) 

(*  IF  THE  SUBSCHEMA’S  CONSTITUENT  IS  NOT  YET  DEFINED,  CREATE  AN  *) 

(*  UNRESOLVED  ENTITY.  WHEN  THE  CONSTITUENT  IS  LATER  DEFINED,  *) 

(*  IF  WILL  REPLACE  THE  UNRESOLVED  ENTITY  IN  THE  CONSTITUENT  *) 

(*  LIST  OF  THE  SUBSCHEMA.  *) 

(*  IF  WE  HAVE  READ  IN  ALL  OF  THE  ENTITY  AND  CLASS  NAMES,  WE  PUSH  *) 

(*  THE  FINAL  SUBSCHEMA  TRANSACTION  ONTO  THE  STACK  AND  PROCESS  *) 

(*  THE  TRANSACTION  STACK.  *) 

(*  IF  WE  HAVE  ENCOUNTERED  AN  ENTITY  CR  CLASS  DEFINITION,  THEN  WE  *) 

(*  SET  A  FLAG  TO  INDICATE  THAT  AFTER  MODELING  THESE  ENTITIES  *) 

(*  AND  CLASSES,  WE  MUST  THEN  MODEL  THE  SUBSCHEMA.  *) 

(*  WRITE  APPROPRIATE  ERROR  MESSAGES.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  03/20/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  7.INCLUDE  DEFSUB  *) 
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(*  ^INCLUDE 
(**) 

PROCEDURE 


DEFSUP  *) 


DEFSUP(VAR  IRC 

RET_REC ; 

VAR  TRANS_STACK 

TRANSPTR; 

VAR  TOKEN 

T_TOKEN ; 

VAR  TOKEN.VALUE 

T_TOKEN_VALUE ; 

VAR  TOKENLOCATION 

INTEGER; 

VAR  TOKEN_LENGTH 

INTEGER; 

VAR  SUBSCHEMA_FLAG 

BOOLEAN; 

VAR  SUB_ENT_HEAD 

ENTITY_LIST_PTR; 

VAR  SUB_ENT_LIST 

ENTITY_LIST_PTR; 

VAR  CLASS_FLAG 

BOOLEAN; 

VAR  CLS_ENT_HEAD 

ENTITY_LIST_PTR; 

VAR  CLS_ENT_LIST 

ENTITY_LIST_PTR ; 

VAR  REP0RT1 

TEXT); 

SUBPROGRAM; 


(**) 

(  * 

\* - 

(* 

(* 

^FUNCTION: 

(* 

(* 

(* 

(* 

BATCH  INTERFACE  ROUTINE  THAT  PROCESSES  A  SUPERTYPE 
DEFINITION. 

^DESCRIPTION  OF  ARGUMENTS: 

(* 

NAME 

I/O 

DESCRIPTION 

(* 

ssssss: 

=:==: 

ii 

ii 

ii 

n 

ii 

ii 

ii 

ii 

n 

ii 

n 

(* 

IRC 

0 

INTERNAL  RETURN  CODE 

(* 

TRANS_STACK 

I/O 

TRANSACTION  STACK 

(* 

TOKEN 

I/O 

TOKEN  FROM  BATCH  INPUT 

(* 

TOKEN.VALUE 

I/O 

TOKEN  VALUE  FROM  BATCH  INPUT 

(* 

TOKENJLOCATION 

I/O 

LOCATION  OF  TOKEN  IN  INPUT  LINE 

(* 

TOKEN.LENGTH 

I/O 

LENGTH  OF  TOKEN 

(* 

(* 

SUBSCHEMA.FLAG 

I/O 

INDICATES  IF  ENTITIES  ARE  DEFINED 
THE  SUBSCHEMA 

WITHIN 

(* 

SUB_ENT_HEAD 

I/O 

POINTS  TO  LIST  OF  SUBSCHEMA  ENTITIES 

(* 

(* 

SUB_ENT_LIST 

I/O 

POINTS  TO  CURRENT  ENTITY  IN  LIST 
SUBSCHEMA  ENTITIES 

OF 

<* 

(* 

CLASS.FLAG 

I/O 

INDICATES  IF  ENTITIES  ARE  DEFINED 
THE  CLASS 

WITHIN 

(* 

CLS_ENT_HEAD 

I/O 

POINTS  TO  LIST  OF  CLASS  ENTITIES 

(* 

(* 

CLS_ENT_LIST 

I/O 

POINTS  TO  CURRENT  ENTITY  IN  LIST 
CLASS  ENTITIES 

OF 

(* 

(* 

(* 

(* 

(* 

REPORT1 

$ COMMONS : 

^ENVIRONMENT: 

I/O 

OUTPUT  FILE 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

0*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INITIALIZE  VARIABLES  *) 

(*  GET  THE  ENTITY  NAME  AND  KIND  NUMBER  *) 

(*  VERIFY  THE  UNIQUENESS  OF  THE  ENTITY  NAME  AND  KIND  NUMBER  AMONG  *) 

(*  MODELED  ENTITIES  AND  THOSE  ON  THE  STACK  *) 

(*  IF  THE  ENTITY  NAME  AND  KIND  NUMBER  ARE  UNIQUE  THEN  CHECK  IF  THE  *) 
(*  SUBSCHEMA  FLAG  OR  CLASS  FLAG  ARE  SET.  IF  SO,  ADD  THE  ENTITY  *) 

(*  NAME  TO  THE  APPROPRIATE  LIST(S).  PUSH  ENTITY  TRANSACTION  ON-  *) 

(*  TO  THE  STACK.  *) 

(*  DEFINE  EACH  ATTRIBUTE  OF  THE  ENTITY  *) 

(*  WHEN  THE  END  OF  THE  ENTITY  IS  ENCOUNTERED,  THEN  PUSH  FINAL  *) 

(*  ENTITY  TRANSACTION  ONTO  THE  TRANSACTION  STACK  AND  PROCESS  *) 

(*  THE  STACK.  *) 

(*  WRITE  ERROR  MESSAGES  AS  APPROPRIATE  *) 

(*  *) 

(*  $ COMMENTS :  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  09/29/87  C.  H.  MOHME  DBMA  *) 

<*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  DEFSUP  *) 
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(*  %INCLUDE  DEFTYP  *) 

(**) 

PROCEDURE  DEFTYP (VAR  IRC  :  RET_REC ; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  TOKEN  :  T_TOKEN ; 

VAR  TOK£N_VALUE  :  T_TOKEN_VALUE ; 

VAR  TOKEN_LOCATION  :  INTEGER; 

VAR  TOKEN_LENGTH  :  INTEGER; 

VAR  SUBSCHEMA_FLAG  :  BOOLEAN; 

VAR  SUB_ENT_HEAD  :  ENTITY_LIST_PTR; 

VAR  SUB_ENT_LIST  :  ENTITY_LIST_PTR; 

VAR  CLASS_FLAG  :  BOOLEAN; 

VAR  CLS_ENT_HEAD  :  ENTITY_LIST_PTR; 

VAR  CLS_ENT_LIST  :  ENTITY_LIST_PTR; 

VAR  REPORT1  :  TEXT); 

SUBPROGRAM; 

(**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  BATCH  INTERFACE  ROUTINE  THAT  PROCESSES  A  DEFINED  TYPE 

(*  DEFINITION. 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 


(* 

(* 

(* 

NAME 

I/O 

DESCRIPTION 

IRC 

0 

INTERNAL  RETURN  CODE 

(* 

TRANS_STACK 

I/O 

TRANSACTION  STACK 

(* 

TOKEN 

I/O 

TOKEN  FROM  BATCH  INPUT 

(* 

TOKENVALUE 

I/O 

TOKEN  VALUE  FROM  BATCH  INPUT 

(* 

TOKEN_LOCATION 

I/O 

LOCATION  OF  TOKEN  IN  INPUT  LINE 

(* 

TOKEN JLENGTH 

I/O 

LENGTH  OF  TOKEN 

(* 

SUBSCHEMA_FLAG 

I/O 

INDICATES  IF  ENTITIES  ARE  DEFINED  WITHIN 

(* 

THE  SUBSCHEMA 

(* 

SUB_ENT_HEAD 

I/O 

POINTS  TO  LIST  OF  SUBSCHEMA  ENTITIES 

(* 

SUB_ENT_LIST 

I/O 

POINTS  TO  CURRENT  ENTITY  IN  LIST  OF 

(* 

SUBSCHEMA  ENTITIES 

(* 

CLASS_FLAG 

I/O 

INDICATES  IF  ENTITIES  ARE  DEFINED  WITHIN 

(* 

THE  CLASS 

(* 

CLS_ENT_HEAD 

I/O 

POINTS  TO  LIST  OF  CLASS  ENTITIES 

(* 

CLS_ENT„LIST 

I/O 

POINTS  TO  CURRENT  ENTITY  IN  LIST  OF 

(* 

CLASS  ENTITIES 

(* 

(* 

<* 

(* 

(* 

REPORT1 

I/O 

OUTPUT  FILE 

^COMMONS : 

^ENVIRONMENT: 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 
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(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 
(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INITIALIZE  VARIABLES  *) 

(*  GET  THE  DEFINED  TYPE  NAME  AND  VERIFY  ITS  UNIQUENESS  AMONG  *) 

(*  ENTITIES  IN  THE  MODEL  AND  ON  THE  STACK  *) 

(*  IF  THE  DEFINED  TYPE  NAME  IS  UNIQUE,  THEN  PUSH  DEFINED  TYPE  *) 

(*  TRANSACTION  ONTO  THE  TRANSACTION  STACK.  *) 

(*  GET  THE  TYPE  DEFINITION.  THE  TYPE  MAY  BE  AN  ENUMERATION,  A  *) 

(*  BASIC  TYPE,  OR  A  DEFINED  TYPE.  *) 

(*  IF  THE  TYPE  DEFINITION  IS  ENUMERATION  THEN  *) 

(*  DEFINE  ENUMERATION  *) 

(*  ELSE  *) 

(*  IF  THE  TYPE  DEFINITION  IS  STRUCTURE  THEN  *) 

(*  DEFINE  STRUCTURE  *) 

(*  ELSE  *) 

(*  IF  THE  TYPE  DEFINITION  IS  A  BASICA  TYPE  THEN  *) 

(*  DEFINE  BASIC  TYPE  *) 

(*  ELSE  *) 

(*  IF  THE  TYPE  DEFINITION  IS  A  DEFINED  TYPE  THEN  *) 

(*  DEFINED  DEFINED  TYPE  *) 

(*  PROCESS  THE  TRANSACTION  STACK  *) 

(*  WRITE  APPROPRIATE  ERROR  MESSAGES  *) 

(*  GET  NEXT  DEFINED  TYPE  NAME  IF  PRESENT  *) 

(*  *) 

(*  $ COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

<*  *) 

(*  ORIGINATED:  03/20/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  DEFTYP  *) 
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(*  %INCLUDE  DISPLIST  *) 

(**) 

PROCEDURE  DISPLIST(VAR  MESS  :  MESSAGE; 

VAR  MEMBERLIST  :  T_ARRAYTV ; 

VAR  MAX_ARRAYSIZE  :  INTEGER; 

VAR  NAME  :  T_NAME; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  DISPLAYS  A  LIST  OF  ENTITIES. 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 


(* 

(* 

(* 

NAME 

I/O 

DESCRIPTION 

MESS 

I 

THE  ERROR  MESSAGE  RECEIVED  FROM  MAINLINE 

(* 

MEMBERLIST 

I 

THE  ARRAY  OF  MEMBERS  TO  SELECT  FROM 

(* 

MAX_ARRAYSIZE 

I 

THE  SIZE  OF  THE  ARRAY  OF  MEMBERS 

<* 

NAME 

0 

THE  MEMBER  SELECTED 

<* 

NEXT_OP 

0 

TELLS  THE  MAINLINE  WHAT  PANEL  TO  CALL 

(* 

NEXT 

(* 

(* 

(* 

(* 

RR 

0 

TELLS  THE  MAINLINE  IF  THERE  IS  AN  ERROR 
AND  IN  WHAT  ROUTINE  IT  OCCURS 

^COMMONS : 

(* 

(* 

NONE 

(* 

^ENVIRONMENT: 

(* 

LANGUAGE:  IBM 

PASCAL 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

DDNAMES  USED 

WITH 

STANDARD  FILES: 

(* 

NONE 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(*  DISPLAY  THE  DISPLAY  LIST  PANEL  (DISPLIST)  BY  MAKING  ISPLNK 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED 

(*  type.  THE  MEMBER  SELECTED  IS  RETURNED  TO  THE  CALLING  PRO- 

(*  CEDURE. 

(* 

(*  ^COMMENTS: 

(* 

(*  $ CHANGE  CONTROL: 

(* 


■*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*> 

*) 

*) 

*> 

*) 

*) 
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(*  %INCLUDE  ENTCLS  *) 

(**) 

PROCEDURE  ENTCLS (VAR  IRC  :  RET_REC ; 

VAR  DATA_REC  :  BLKDATA) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  BATCH  INTERFACE  ROUTINE  THAT  DETERMINES  IF  A  SPECIFIED  *) 

(*  IDENTIFIER  IS  A  MODELED  ENTITY  OR  CLASS.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  DATA_REC  I/O  CONTAINS  ENTITY  DATA  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INITIALIZE  VARIABLES  *) 

(*  DETERMINE  IF  THE  NAME  IS  AN  ENTITY.  IF  IT  IS,  GET  THE  KEY.  *) 

(*  IF  THE  NAME  IS  NOT  AN  ENTITY,  DETERMINE  IF  IT  IS  A  CLASS.  IF  *) 

(*  IT  IS,  GET  THE  KEY.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *> 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  03/20/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  XINCLUDE  ENTCLS  *) 
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(*  %INCLUDE  ERRMSG  *) 

(**) 

PROCEDURE  ERRMSG(VAR  ENT_KIND  :  INTEGER; 

VAR  REP0RT1  :  TEXT); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  BATCH  INTERFACE  ROUTINE  THAT  WRITES  APPROPRIATE  ERROR  *) 

(*  MESSAGES  TO  THE  REPORT  FILE.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  ENTJCIND  I  THE  KIND  OF  ENTITY  BEING  CREATED  *) 

(*  REPORT1  I/O  THE  BATCH  OUTPUT  FILE  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  $  COMMENTS:  *) 

(*  WRITE  APPROPRIATE  ERROR  MESSAGES  FOR  THE  SUBSCHEMA,  CLASS,  *) 
<*  ENTITY,  SUPERTYPE,  DEFINED  TYPE,  STRUCTURE,  AND  GLOBAL  *) 

(*  ATTRIBUTE  KINDS.  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  12/12/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  XINCLUDE  ERRMSG  *) 
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(*  %INCLUDE  ERRREC  *) 

(**) 

PROCEDURE  ERRREC(VAR  IRC 

VAR  ENT_KIND 
VAR  TRANS_STACK 
VAR  SUBS CHEMA_FLAG 
VAR  SUB_ENT_HEAD 
VAR  SUB_ENT_LIST 
VAR  CLASS_FLAG 
VAR  CLS_ENT_HEAD 
VAR  CLS_ENT_LIST 

SUBPROGRAM; 

(**) 


RET_REC ; 

INTEGER; 

TRANS PTR; 

BOOLEAN; 

ENTITY_LI ST_PTR ; 
ENTITY_LIST_PTR ; 
BOOLEAN; 

ENTITY_LIST_PTR; 
ENTITY_LIST_PTR) ; 


(*■ 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

<* 

(* 

<* 

<* 

(* 

(* 


^FUNCTION: 

BATCH  INTERFACE  ROUTINE  THAT  PERFORMS  THE  NECESSARY  ACTIONS 
TO  RECOVER  FROM  AN  INPUT  ERROR. 


^DESCRIPTION  OF  ARGUMENTS : 

NAME  I/O  DESCRIPTION 


IRC  I/O 

ENTJCIND  I 

TRANS_STACK  I/O 

SUBSCHEMA_FLAG  I/O 

SUB_ENT_HEAD  I/O 

SUB_ENT_LIST  I/O 

CLASS_FLAG  I/O 

CLS_ENT_HEAD  I/O 

CLS_ENT_LIST  I/O 


INTERNAL  RETURN  CODE 
KIND  OF  ENTITY 
TRANSACTION  STACK 

INDICATES  IF  ENTITIES  ARE  DEFINED  WITHIN 
THE  SUBSCHEMA 

POINTS  TO  THE  LIST  OF  SUBSCHEMA  ENTITIES 
POINTS  TO  THE  CURRENT  ENTITY  IN  THE  LIST 
OF  SUBSCHEMA  ENTITIES 

INDICATES  IF  ENTITIES  ARE  DEFINED  WITHIN 
THE  CLASS 

POINTS  TO  THE  LIST  OF  CLASS  ENTITIES 
POINTS  TO  THE  CURRENT  ENTITY  IN  THE  LIST 
OF  SUBSCHEMA  ENTITIES 


$ COMMONS : 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 


^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT 


^PROCESSING  DESCRIPTION: 


■*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 
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(* 

(*  INITIALIZE  VARIABLES 

(*  CLEAR  TRANSACTION  STACK 

(*  CASE  TYPE  OF  RECOVERY  OF 

:  DISCARD  TOKENS  UNTIL  END_S CHEKA  ENCOUNTERED 
:  DISCARD  TOKENS  UNTIL  END_CLASS  ENCOUNTERED 
IF  CLASS  IS  IN  ANOTHER  CLASS,  DISCARD  TOKENS 
UNTIL  END_CLASS  IS  ENCOUNTERED 
IF  CLASS  IS  IN  A  SUBSCHEMA,  DISCARD  TOKENS  UNTIL 
END_SCHEMA  ENCOUNTERED 

:  DISCARD  TOKENS  UNTIL  END_ENTITY  ENCOUNTERED 
IF  ENTITY  IS  IN  A  CLASS,  DISCARD  TOKENS  UNTIL 
END_CLASS  ENCOUNTERED 

IF  ENTITY  IS  IN  A  SUBSCHEMA,  DISCARD  TOKENS 
UNTIL  END_SCHEMA  ENCOUNTERED 

:  DISCARD  TOKENS  UNTIL  SEMICOLON  ENCOUNTERED 
IF  DEFINED  TYPE  IS  IN  SUBSCHEMA  DISCARD  TOKENS 
UNTIL  END_SCHEMA  ENCOUNTERED 
(*  SET  FLAGS  TO  FALSE 
(* 

(*  ^COMMENTS: 

(* 

(*  $ CHANGE  CONTROL: 

(* 

(*  ORIGINATED:  03/20/87  C.  H.  MOHME  DBMA 

(* 

(* - 

(* 

(*END - 

(*  END  %INCLUDE  ERRREC  *) 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


SUBSCHEMA 

CLASS 


ENTITY 


DEFINED 

TYPE 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

-*) 

*) 

■*) 
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(*  BEGIN  %INCLUDE  GETDD  ***********************************************) 


<* 


') 


PROCEDURE  GETDD  (  CONST 

KIND 

INTEGER; 

CONST 

MAX_AVAIL 

INTEGER; 

CONST 

ATTRIBUTE_ORDER 

CHAR; 

VAR 

USER_ARRAY 

T_USER_ARRAY ; 

VAR 

MAX_ACTUAL 

INTEGER; 

VAR 

RETURN.CODE 

INTEGER  ); 

EXTERNAL; 

(* 

(*  $ FUNCTION: 

(*  READ  THE  DATA  DICTIONARY  INTO  THE  APPLICATION  PROGRAM. 


*) 

*) 

*) 


<* 

(* 

(* 

(* 

(* 

(* 

c* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 


*) 


^DESCRIPTION  OF  ARGUMENTS:  *) 

NAME  I/O  DESCRIPTION  *) 

KIND  I  A  KIND  NUMBER  OF  ENTITY  *) 

MAX_ACTUAL  0  AN  ACTUAL  NUMBER  OF  RECORDS  IN  *) 

ENTITY  DEFINITION  *) 

MAX_AVAIL  I  A  NUMBER  OF  80  CHARACTER  RECORDS  *) 

AVAILABLE  IN  CALLER  TO  HOLE  *) 

ENTITY  DEFINITION  *) 

USER_ARRAY  0  AN  ENTITY  DEFINITION  *) 

RETURN.CODE  0  RETURN  CODE  *) 

-1  =  ACTUAL  SIZE  GREATER  THAN  *) 

SPACE  AVAILABLE  *) 

0  =  SUCCESS  *) 

1  =  KIND  NOT  IN  DATA  DICTIONARY  *) 

*) 

$ COMMONS:  •  *) 

*) 

^ENVIRONMENT:  *) 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *> 

*) 

^EXECUTION  PROCEDURE:  *) 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

*) 

^PROCESSING  DESCRIPTION:  *) 

LOOP  THROUGH  DATA  DICTIONARY  INDEX  FILE  *) 

IF  KIND  IN  DATA  DICTIONARY  THEN  *) 

GET  ENTITY  DEFINITION  FROM  DDFILE  *) 

FILL  UP  THE  ARRAY  OF  ENTITY  DEFINITIONS  UP  TO  NUMBER  *) 
OF  RECORDS  AVAILABLE  IN  CALLER  *) 

END  IF  *) 

END  LOOP  *) 

*) 
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(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  ORIGINATED:  23  MARCH  1987,  M.  H.  CHOI,  DBMA  *) 

(*  *) 

(*  END  %INCLUDE  GETDD  ************************************************) 
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(*  BEGIN  %INCLUDE  LEXICAL  *********************************************) 


(* 


*) 


PROCEDURE  LEXICAL  (  VAR 

TOKEN  :  TJTOKEN; 

VAR 

TOKEN.VALUE  :  T_TOKEN_VALUE ; 

VAR 

TOKEN.LOCATION  :  INTEGER; 

VAR 

TOKEN.LENGTH  :  INTEGER; 

VAR 

REP0RT1  :  TEXT); 

SUBPROGRAM; 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

LOCATE  THE  LONGEST  POSSIBLE  LEXEME  FROM  WHICH  A  TOKEN  MAY 

*) 

(* 

BE  DETERMINED 

* 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME 

I/O  DESCRIPTION 

*) 

(* 

===== 

-=-=-== - 

*) 

(* 

TOKEN 

I/O  INPUT  =  TOKEN  TYPE  FROM  PREVIOUS 

CALL 

*) 

(* 

OR  INITIALIZATION  FLAG 

*) 

(* 

OUTPUT  =  CURRENT  TOKEN  TYPE 

*) 

(* 

TOKEN.VALUE 

0  CURRENT  TOKEN  VALUE 

*) 

(* 

TOKEN.LOCATION  0  START  LOCATION  OF  TOKEN  IN  REPORT 

LINE 

*) 

(* 

TOKEN.LENGTH 

0  LENGTH  OF  TOKEN  IN  REPORT  LINE 

*) 

(* 

REP0RT1 

I/O 

*) 

(* 

*) 

(* 

^COMMONS: 

*) 

(* 

NONE 

*) 

(* 

*) 

<* 

^ENVIRONMENT : 

*) 

(* 

LANGUAGE:  IBM 

PASCAL  SEGMENT  SUBPROGRAM 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

DDNAMES  USED 

WITH  STANDARD  FILES: 

*) 

(* 

SOURCE 

:  THE  INPUT  STREAM  OF  CHARACTERS 

*) 

(* 

REP0RT1 

:  FORMATTED  REPORT  OF  THE  INPUT 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT 

*) 

c* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

? 

*) 

(* 

*) 

(* 

$ COMMENTS : 

*) 

(* 

? 

*) 

(* 

<* 

(* 

(* 

(* 


$ CHANGE  CONTROL: 

ORIGINATED:  18  MAR  87,  G.  A.  WHITE 


*) 

*) 

*) 

*) 

*> 
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(*  REVISED:  7  DEG  87,  G.  A.  WHITE,  ADD  PARAMETERS  FOR  *) 

(*  LOCATION  AND  LENGTH  OF  TOKEN  IN  REPORT  LINE.  *) 

(*  *) 
(*  END  %INCLUDE  LEXICAL  ***********************************************) 
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(*  %INCLUDE  LMEM23  *) 

(**) 

PROCEDURE  LMEM23(VAR  MESS  :  MESSAGE; 

VAR  MEMBERS  :  T_ARRAYTV ; 

VAR  SIZE  :  INTEGER; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  LIST  MEMBERS  (LMEM23)  PANEL  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  MEMBERS  I  THE  ARRAY  OF  MEMBERS  TO  DISPLAY  *) 

(*  SIZE  I  THE  SIZE  OF  THE  ARRAY  OF  MEMBERS  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

<*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  LIST  MEMBERS  PANEL  (LMEM23)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 


3-339 


Cl  PS560240032U 
April  1990 


(*  %INCLUDE  MCREATE  *) 

(**) 

PROCEDURE  MCREATE (VAR  MESS  :  MESSAGE; 

VAR  NEXT_OP  :  OPERATIONS; 
VAR  RR  :  RE1.REC); 

SUBPROGRAM; 

(**) 

(* - 

(* 

(* 

(* 

(* 

(* 


-*) 

*) 

*) 

*) 

*) 

*) 


^FUNCTION: 

THIS  PROCEDURE: 


DISPLAYS  THE  CREATE  MENU 


(* 

^DESCRIPTION  OF 

ARGUMENTS : 

*) 

(* 

NAME 

I/O 

DESCRIPTION 

*) 
Jf  \ 

(* 

MESS 

I 

THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 

*  ) 
*) 

<* 

NEXT_OP 

0 

ENUMERATED  TYPE  INDICATING  THE  NEXT 

*> 

(* 

OPERATION 

*) 

(* 

RR 

0 

INDICATES  IF  AN  ERROR  HAS 

OCCURRED  AND, 

*) 

(* 

IF  ONE  HAS,  WHAT  ROUTINE 

IT  OCCURRED  IN 

*) 

(* 

*) 

(* 

$ COMMONS : 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

DDNAMES  USED  WITH 

STANDARD  FILES: 

*) 

(* 

NONE 

*) 

(* 

*) 

<* 

^EXECUTION  PROCEDURE: 

*) 

(* 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION 

• 

• 

*) 

(* 

DISPLAY  THE 

:  CREATE 

PANEL  (MCREATE)  BY  MAKING 

ISPLNK  CALLS. 

*) 

<* 

THE  OPTION 

CHOSEN 

IS  TRANSLATED  INTO  AN  ENUMERATED  TYPE. 

*) 

(* 

*) 

<* 

'^COMMENTS: 

*) 

<* 

NONE 

*) 

(* 

*) 

(* 

^CHANGE  CONTROL: 

*) 

<* 

*) 
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(*  %INCLUDE  MFILMOD  *) 

(**) 

PROCEDURE  MFILMOD (VAR  MESS  :  MESSAGE; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  PROCEDURE:  *) 

(*  DISPLAYS  THE  FILE/RETRIEVE  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  FILE  MODEL  PANEL  (MFILMOD)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  *) 

(*  *> 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *> 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  MINCLUD  *) 

(**) 

PROCEDURE  MINCLUD(VAR  MESS  :  MESSAGE; 

VAR  REPORT_TYPE  :  OPERATIONS; 

VAR  MEMBERS  :  T_ARRAYTV ; 

VAR  SIZE  :  INTEGER; 

VAR  MEMBER  :  T_NAME; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  LIST  OF  SUBSCHEMAS  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  REPORTJTYPE  I  THE  TYPE  OF  REPORT  TO  BE  GENERATED  *) 

(*  MEMBERS  I  THE  ARRAY  OF  MEMBERS  TO  SELECT  FROM  *) 

(*  SIZE  I  THE  SIZE  OF  THE  ARRAY  OF  MEMBERS  *) 

(*  MEMBER  0  THE  MEMBER  SELECTED  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  SUBSCHEMA  PANEL  (MINCLUD)  (FROM  WHICH  A  SUB-  *) 

(*  SCHEMA  MAY  BE  SELECTED)  BY  MAKING  ISPLNK  CALLS.  THE  OPTION  *) 

(*  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  TYPE.  *) 

I.’*  *) 
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(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  MMAIN  *) 

(**) 

PROCEDURE  MMAIN(VAR  MESS  :  MESSAGE; 

VAR  NEXT.OP  :  OPERATIONS; 
VAR  RR  ;  RET_REC) ; 

SUBPROGRAM; 

(**) 


v.*— 

(* 

(* 

^FUNCTION: 

—  t 
*) 
*) 

(* 

THIS  PROCEDURE 

; 

*) 

(* 

(* 

DISPLAYS  THE  MAIN  MENU 

*) 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME 

I/O 

DESCRIPTION 

*) 

(* 

===== 

=== 

ii 

ii 

ii 

n 

ii 

ii 

ii 

ii 

ii 

ii 

ii 

*) 

(* 

MESS 

I 

THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 

*) 

(* 

(* 

NEXT_OP 

0 

ENUMERATED  TYPE  INDICATING  THE  NEXT 
OPERATION 

*) 

*) 

(* 

(* 

RR 

0 

INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 
IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 

*) 

*) 

(*  *) 


(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  MAIN  MENU  PANEL  (MMAIN)  BY  MAKING  ISPLNK  CALLS.  *) 

(*  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  TYPE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  MNEWMOD  *) 

(**) 

PROCEDURE  MNEWMOD (VAR  MESS  :  MESSAGE; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  ^FUNCTION:  *) 

(*  THIS  PROCEDURE:  *) 

(*  DISPLAYS  THE  FILE/RETRIEVE  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  NEW  MODEL  PANEL  (MNEWMOD)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  BEGIN  ^INCLUDE  MQBHALL  *********************************************) 


(*  *) 

PROCEDURE  MQBHALL  (  CONST  NO_OF_KINDS  :  INTEGER; 

VAR  NO_OF_ENTRY  :  INTEGER  ); 

SUBPROGRAM; 

(*  *) 

(*  $ FUNCTION:  *) 

(*  PRINT  ALL  ENTITIES  IN  THE  MODEL  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  NO_OF_KINDS  I  NUMBER  OF  KINDS  IN  THE  MODEL  *) 

(*  NO_OF_ENTRY  I/O  NUMBER  OF  ENTITIES  PRINTED  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  $ EXE CUT I ON  PROCEDURE:  *) 

(*  CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  LOOP  THROUGH  LIST  OF  ENTITIES  IN  THE  MODEL  *) 

(*  PRINT  ENTITY  *) 

(*  END  LOOP  *) 

(*  *) 

(*  ^COMMENTS:  *) 

<*  *) 

(*  $CHANGE  CONTROL:  *) 

(*  REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION)  *) 

(*  ORIGINATED:  10  DECEMBER,  M.  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  %INCLUDE  MQBHALL  ***********************************************) 


(*  BEGIN  %INCLUDE  MQBHATT  ********** 
(* 

PROCEDURE  MQBHATT  (  CONST  KIND 

CONST  INST_NO 
VAR  NO_OF_ENTRY 
SUBPROGRAM; 


Cl  PS560240032U 
April  1990 


it*******************************************') 

*) 

IND  :  INTEGER; 

NST_NO  :  INTEGER; 

0_0F_ENTRY  :  INTEGER  ); 


^FUNCTION: 

PRINT  INDIVIDUAL  INSTANCES  OF  A  SPECIFIC  KIND 


^DESCRIPTION  OF  ARGUMENTS: 


DESCRIPTION 


KIND 
INST_NO 
NO  OF  ENTRY 


A  KIND  NUMBER  OF  ENTITY 

INSTANCE  NUMBER 

NUMBER  OF  ENTITIES  PRINTED 


^COMMONS : 


(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  PRINT  ADB,  CONSTITUENT  LIST,  AND  USER  LIST.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION)  *) 

(*  ORIGINATED:  10  DECEMBER,  M.  H.  CHOI,  DBMA  *) 

(*  *) 

(*  END  %INCLUDE  MQBHATT  ***********************************************) 
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(*  BEGIN  %INCLUDE  MQBHATTS  ********************************************) 

(*  *) 
PROCEDURE  MQBHATTS  (  CONST  KIND  :  INTEGER; 

VAR  NO_OF_ENTRY  :  INTEGER  ); 

SUBPROGRAM; 


(* 

(* 

(* 

(* 

(* 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


^FUNCTION: 

PRINT  ALL  ENTITIES 


OF  A  SPECIFIC  KIND 


^DESCRIPTION  OF  ARGUMENTS: 


(* 

NAME 

I/O 

DESCRIPTION 

(* 

===== 

ii 

n 

ii 

ii 

ii 

ii 

ii 

ii 

ii 

ii 

ii 

(* 

KIND 

i 

A  KIND  NUMBER  OF  ENTITY 

(* 

NO_OF_ENTRY 

I/O 

NUMBER  OF  ENTITIES  PRINTED 

$ COMMONS : 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

$ EXE CUT I ON  PROCEDURE: 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 
^PROCESSING  DESCRIPTION: 

LOOP  THROUGH  LIST  OF  ENTITIES  OF  A  SPECIFIC  KIND 
PRINT  ADB,  CONSTITUENT  LIST,  AND  USER  LIST 
END  LOOP 

^COMMENTS: 


$ CHANGE  CONTROL: 

REVISED:  (DATE,  NAME,  GROUP, 
ORIGINATED:  10  DECEMBER,  M. 


REASON/DESCRIPTION) 
H.  CHOI,  DBMA 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 


(*  END  %INCLUDE  MQBHATTS  **********************************************) 
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) 

(*  BEGIN  %INCLUDE  MQBHENT  ********************************************) 


(*  *) 

PROCEDURE  MQBHENT  (  CONST  MEMBER  :  T_CHAR56; 

VAR  NO_OF_ENTRY  :  INTEGER; 

VAR  ACTION  :  OPERATIONS  ); 

SUBPROGRAM; 

<*  *) 

(*  $ FUNCTION:  *) 

(*  DISPLAY  BATCH  ENTITY  MENU  (  SELECT  TO  PRINT  ALL  ENTITIES  OF  *) 

(*  A  SPECIFIC  KIND  OR  TO  PRINT  INDIVIDUAL  INSTANCES  OF  A  *) 

(*  SPECIFIC  KIND  )  *) 

(*  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MEMBER  I  ENTITY  OF  A  SPCIFIC  KIND  *) 

(*  NO_OF_ENTRY  I/O  NUMBER  OF  ENTITIES  PRINTED  *) 

(*  ACTION  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  NAME/VALUE  INTERFACE  *) 

(*  CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  BATCH  ENTITY  MENU  *) 

(*  SELECT  TO  PRINT  ALL  ENTITIES  OF  A  SPECIFIC  KIND  OR  *) 

(*  TO  PRINT  INDIVIDUAL  INSTANCES  OF  A  SPECIFIC  KIND  *) 

<*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION)  *) 

(*  ORIGINATED:  10  DECEMBER,  M.  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  %INCLUDE  MQBHENT  ***********************************************) 
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(*  BEGIN  %INCLUDE  MQBHMAIN  ********************************************) 


(*  *) 
PROCEDURE  MQBHMAIN  (  CONST  MEMBERLIST  :  T_MEMBER; 

CONST  NO_OF_KINDS  :  INTEGER; 

VAR  ACTION  :  OPERATIONS  ); 

SUBPROGRAM; 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

c* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

<* 

(* 

<* 

(* 

(* 

(* 


^FUNCTION: 

DISPLAY  BATCH  MAIN  MENU  (  SELECT  TO  PRINT  ALL  ENTITIES  IN 
THE  MODEL  OR  TO  PRINT  ALL  ENTITIES  OF  A  SPECIFIC  KIND  ) 

^DESCRIPTION  OF  ARGUMENTS: 

NAME 

MEMBERLIST 
NO_OF_KINDS 
ACTION 


^COMMONS : 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

NAME/VALUE  INTERFACE 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 

^PROCESSING  DESCRIPTION: 

DISPLAY  BATCH  MAIN  MENU 

$ COMMENTS : 


I/O  DESCRIPTION 

I  LIST  OF  ENTITIES  IN  THE  MODEL 
I  NUMBER  OF  KINDS  IN  THE  MODEL 
0  ENUMERATED  TYPE  INDICATING  THE  NEXT 
OPERATION 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 


$ CHANGE  CONTROL:  *) 

REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION)  *) 

ORIGINATED:  10  DECEMBER,  M.  H.  CHOI,  DBMA  *) 

*) 

END  %INCLUDE  MQBHMAIN  **********************************************) 
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(*  BEGIN  %INCLUDE  MQCLMU  ************ 
(* 

PROCEDURE  MQCLMU  (  CONST  LIST_OF_CNSTS 

CONST  CL_NAME 
CONST  NO_OF_CL 
VAR  MEMBER 
VAR  ACTION 
SUBPROGRAM; 


*********************************************) 

*) 

,IST_OF_CNSTS  :  LISTKEY; 

L_NAME  :  T_CL_NAME; 

[0_0F_CL  :  INTEGER; 

EMBER  :  T_CHAR56; 

.CTION  :  OPERATIONS  ); 


^FUNCTION: 

DISPLAY  A  LIST  OF  CONSTITUENTS  FOR  A  SPECIFIC  KIND 


^DESCRIPTION  OF  ARGUMENTS: 


LIST_OF_CNSTS 

CL_NAME 

NO_OF_CL 

MEMBER 

ACTION 


DESCRIPTION  *) 
===========  *) 

POINTER  TO  CONSTITUENT  LIST  *) 
POINTER  ATTRIBUTE  NAME  *) 
NUMBER  OF  CONSTITUENT  LIST  *) 
SELECTED  CONSTITUENT  FOR  DEFINITIONS  *) 
ENUMERATED  TYPE  TO  INDICATE  THE  NEXT  *) 
OPERATION  *) 


$ COMMONS : 

^ENVIRONMENT : 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

NAME/VALUE  INTERFACE 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 
^PROCESSING  DESCRIPTION: 


$ COMMENTS : 

$ CHANGE  CONTROL: 

REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION) 
ORIGINATED:  10  DECEMBER,  M.  H.  CHOI,  DBM 


(*  END  XINCLUDE  MQCLMU  ************************************************) 
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(*  BEGIN  %INCLUDE  MQGETVAL  ********************************************) 
(*  *) 


PROCEDURE  MQGETVAL  (  CONST  DATA_TYPE  :  INTEGER; 

CONST  SIZE  :  INTEGER; 

CONST  ATTRIBUTE_VALUE  :  T_ATTRIBUTE_VALUE ; 

VAR  VAL  :  STRING(16)  ); 

SUBPROGRAM; 

(*  *) 
(*  $ FUNCTION:  *) 

(*  CONVERT  ATTRIBUTE  VALUE  TO  A  STRING  VALUE  *) 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

<* 


*) 

^DESCRIPTION  OF  ARGUMENTS:  *) 

NAME  I/O  DESCRIPTION  *) 

DATA_TYPE  I  TYPE  OF  THE  VALUE  *) 

SIZE  I  SIZE  OF  THE  VALUE  *) 

ATTRIBUTE_VALUE  I  DEPENDS  ON  THE  TYPE  *) 

VAL  0  STRING  VALUE  *) 

*) 

$ COMMONS :  *) 

^ENVIRONMENT :  *) 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

^EXECUTION  PROCEDURE:  *) 

NAME/VALUE  INTERFACE  *) 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

^PROCESSING  DESCRIPTION:  *) 

?  *) 

^COMMENTS:  *) 

$ CHANGE  CONTROL:  *) 

REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION)  *) 

ORIGINATED:  15  DECEMBER  1987,  M.  H.  CHOI,  DBMA  *) 

*) 


END  %INCLUDE  MQGETVAL  **********************************************) 
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(*  BEGIN  %INCLUDE  MQGTDEFN  ********************************************) 


PROCEDURE  MQGTDEFN  (  CONST  KIND 

CONST  ENTITY  JCEY 
VAR  MEMBERLIST 
VAR  TOTAL_MEMBER 
VAR  CL_NAME 
VAR  NO_OF_CL 

SUBPROGRAM; 


INTEGER; 
ENTKEY; 
T_MEMBERLIST; 
INTEGER; 
T_CL_NAME ; 
INTEGER  ); 


^FUNCTION: 

GET  ENTITY  DEFINITIONS  OF  A  SPECIFIC  KIND 


^DESCRIPTION  OF  ARGUMENTS: 


KIND 

ENTITYJCEY 

MEMBERLIST 

TOTAL_MEMBER 

CL_NAME 

NO  OF  CL 


DESCRIPTION  *) 

===========  *) 

A  KIND  NUMBER  OF  ENTITY  *) 

POINTER  TO  ENTITY  INSTANCE  *) 

LIST  OF  ATTRIBUTE  NAMES  WITH  A  VALUE  *) 
TOTAL  NUMBER  OF  MEMBERS  IN  THE  LIST  *) 
LIST  OF  ATTRIBUTE  NAMES  IN  THE  *) 

CONSTITUENT  LIST  *) 

TOTAL  NUMBER  OF  CONSTITUENT  LIST  *) 


$ COMMONS : 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 
^PROCESSING  DESCRIPTION: 

OBTAIN  ENTITY  DEFINITIONS  FROM  THE  DATA  DICTIONARY 
^COMMENTS : 

$CE4NGE  CONTROL: 

REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION) 
ORIGINATED:  10  DECEMBER,  M.  H.  CHOI,  DBM4 


(*  END  %INCLUDE  MQGTDEFN  **********************************************) 
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(*  BEGIN  %INCLUDE  MQIAATT  *********************************************) 
(*  *) 
PROCEDURE  MQIAATT  (  CONST  KIND  :  T_CHAR48; 


CONST  INST_N0  :  INTEGER; 

VAR  TEMP_MEMBER  :  T_CHAR56; 

VAR  ACTION  :  OPERATIONS 

); 

SUBPROGRAM; 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

PRINT  INDIVIDUAL  INSTANCES  OF  A  SPECIFIC 

KIND 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME  I/O  DESCRIPTION 

*) 

(* 

ii 

ii 

ii 

ii 

n 

ii 

ii 

ii 

ii 

ii 

ii 

ii 

ii 

ii 

n 

ii 

n 

ii 

*) 

(*  KIND  I  A  KIND  NUMBER  OF  ENTITY  *) 


(* 

INST_NO  I 

INSTANCE  NUMBER 

*) 

<* 

TEMP_MEMBER  0 

SELECTED  ENTITY 

*) 

(* 

ACTION  0 

ENUMERATED  TYPE  INDICATING  THE  NEXT 

*) 

(* 

OPERATION 

*) 

(* 

*) 

(* 

^COMMONS : 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

(SEGMENT  SUBPROGRAM) 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

NAME/VALUE  INTERFACE 

*) 

c* 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

<* 

? 

*) 

<* 

*) 

(* 

^COMMENTS : 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

REVISED:  (DATE,  NAME, 

GROUP,  REASON/DESCRIPTION) 

*) 

<* 

ORIGINATED:  15  DECEMBER  1987,  M.  H.  CHOI,  DBMA 

*) 

(* 

*) 

(* 

END  %INCLUDE  MQIAATT  ***********************************************) 
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(*  BEGIN  %INCLUDE  MQIAENT  *********************************************) 


(*  *) 

PROCEDURE -MQIAENT  (  CONST  MEMBER  :  T_CHAR56; 

VAR  ACTION  :  OPERATIONS  ); 

SUBPROGRAM; 

(*  *) 

(*  $ FUNCTION:  *) 

(*  DISPLAY  INTERACTIVE  ENTITY  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MEMBER  I  ENTITY  OF  A  SPECIFIC  KIND  *) 

(*  ACTION  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  NAME/VALUE  INTERFACE  *) 

(*  CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  ?  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION)  *) 

(*  ORIGINATED:  15  DECEMBER  1987,  M.  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  XINCLUDE  MQIAENT  ***********************************************) 
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(*  BEGIN  %INCLUDE  MQIAMAIN  *******************************************) 
(*  *) 
PROCEDURE  MQIAMAIN  (  CONST  MEMBERLIST  :  T_MEMBER ; 

CONST  NO_OF_KINDS  :  INTEGER; 

VAR  ACTION  :  OPERATIONS  ); 


SUBPROGRAM; 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

DISPLAY  MIN  INTERACTIVE  MENU 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME  I/O 

DESCRIPTION 

*) 

(* 

MEMBERLIST  I 

LIST  OF  ENTITIES  IN  THE  MODEL 

) 

*) 

(* 

NO_OF_KINDS  I 

NUMBER  OF  KINDS  IN  THE  MODEL 

*) 

(* 

ACTION  0 

ENUMERATED  TYPE  INDICATING  THE  NEXT 

*) 

(* 

OPERATION 

*) 

(* 

*) 

(* 

$ COMMONS : 

*) 

(* 

*) 

(* 

^ENVIRONMENT : 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

(SEGMENT  SUBPROGRAM) 

*) 

(* 

HARDWARE  SYSTEM:  IBM 

360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

NAME/VALUE  INTERFACE 

*) 

(* 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

DISPLAY  INTERACTIVE  MAIN  MENU 

*) 

(* 

SELECT  AN  ENTITY  FOR 

THE  DEFINITIONS 

*> 

<* 

*) 

(* 

^COMMENTS: 

*) 

(* 

*> 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

REVISED:  (DATE,  NAME, 

GROUP,  REASON/DESCRIPTION) 

*) 

(* 

ORIGINATED:  15  DECEMBER  1987,  M.  H.  CHOI,  DBMA 

*) 

(* 

*) 

(* 

END  %INCLUDE  MQIAMAIN  **********************************************) 
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(*  BEGIN  %INCLUDE  MQNUSRMU  *******************************************) 
(*  *) 
PROCEDURE  MQNUSRMU  (  VAR  ACTION  :  OPERATIONS  ); 


SUBPROGRAM; 


(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

DISPLAY  A  MENU  INDICATING  NO  USERS  FOR  A  SPECIFIC  ENTITY 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(*  NAME  I/O  DESCRIPTION  *) 


(* 

ACTION  0 

ENUMERATED  TYPE  INDICATING  THE  NEXT 

*) 

(* 

• 

OPERATION 

*) 

(* 

*) 

(* 

$ COMMONS : 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

(SEGMENT  SUBPROGRAM) 

*) 

(* 

HARDWARE  SYSTEM:  IBM 

360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

NAME/VALUE  INTERFACE 

*) 

(* 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

? 

*) 

(* 

*) 

(* 

^COMMENTS : 

*) 

(* 

*) 

<* 

$ CHANGE  CONTROL: 

*) 

(* 

REVISED:  (DATE,  NAME, 

GROUP,  REASON/DESCRIPTION) 

*) 

(* 

ORIGINATED:  15  DECEMBER  1987,  M.  H.  CHOI,  DBMA 

*) 

(* 

*) 

(*  END  %INCLUDE  MQNUSRMU  **********************************************) 


i 
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(*  ^INCLUDE  MQUDVR  *) 

C**) 

f'k  _  _ 

\ 

- 

) 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

THIS  IS  THE  MAINLINE  PROGRAM  WHICH  DRIVES 

THE  MODEL  QUERY 

*) 

(* 

UTILITY  OF  THE  SCHEMA  MANAGER. 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

$ COMMONS: 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

DDNAMES  USED  WITH  STANDARD  FILES: 

*) 

(* 

DDFILE  =  THE  DATA  DICTIONARY  FILE 

DEFINITIONS. 

*) 

(* 

*) 

(* 

DDINX  =  THE  DATA  DICTIONARY  FILE 

INDEX. 

*) 

(* 

*) 

(* 

FT08F001  =  PART  MODEL  MASTER  FILE  (PID). 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

*) 

(* 

*) 

(* 

$ COMMENTS ; 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

*) 
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(*  BEGIN  %INCLUDE  MQUSRMU  ******************************  .**************) 

(*  *) 
PROCEDURE  MQUSRMU  (  CONST  LIST_OF_USERS  :  LISTKEY; 

VAR  TEMP_MEMBER  :  T_CHAR56; 

VAR  ACTION  :  OPERATIONS  ); 


SUBPROGRAM; 


(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

DISPLAY  LIST  OF  USERS 

FOR  A  SPECIFIC  ENTITY 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME  I/O 

DESCRIPTION 

*) 

*\ 

(* 

LIST_OF_USERS  I 

LIST  OF  USERS  FOR  A  SPECIFIC  ENTITY 

) 

*) 

(* 

TEMP_MEMBER  0 

SELECTED  USER  FOR  THE  DEFINITIONS 

*) 

(* 

ACTION  0 

ENUMERATED  TYPE  INDICATING  THE  NEXT 

*) 

(* 

OPERATION 

*) 

(* 

*) 

(* 

$ COMMONS : 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

(SEGMENT  SUBPROGRAM) 

*) 

(* 

HARDWARE  SYSTEM:  IBM 

360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

NAME/VALUE  INTERFACE 

*) 

(* 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

? 

*) 

(* 

*) 

(* 

$ COMMENTS : 

*) 

(* 

*> 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

REVISED:  (DATE,  NAME, 

GROUP,  REASON/DESCRIPTION) 

*) 

(* 

ORIGINATED:  15  DECEMBER  1987,  M.  H.  CHOI,  DBMA 

*) 

(* 

*) 

(* 

END  %INCLUDE  MQUSRMU  ***********************************************) 
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(*  ^INCLUDE  MREPORT  *) 

(**) 

PROCEDURE  MREPORT (VAR  MESS  :  MESSAGE; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  PROCEDURE:  *) 

(*  DISPLAYS  THE  REPORT  MENU  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

<*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  REPORT  MENU  (MREPORT)  BY  MAKING  ISPLNK  CALLS.  *) 

(*  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  TYPE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  7INCLUDE  MREVIEW  *) 

(**) 

PROCEDURE  MREVIEW (VAR  MESS  :  MESSAGE; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  THIS  PROCEDURE: 

(*  DISPLAYS  THE  REVIEW  MENU 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 

(*  NAME  I/O  DESCRIPTION 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT 

(*  OPERATION 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 

(* 

(*  ^COMMONS: 

(*  NONE 

(* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(*  DDNAMES  USED  WITH  STANDARD  FILES: 

(*  NONE 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(*  DISPLAY  THE  REVIEW  PANEL  (MREVIEW)  BY  MAKING  ISPLNK  CALLS. 

(*  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  TYPE. 

(* 

(*  ^COMMENTS: 

(*  NONE 

(* 

(*  $ CHANGE  CONTROL: 

(* 


-*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*> 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  MUPDATE  *) 

(**) 

PROCEDURE  MUPDATE (VAR  MESS  :  MESSAGE; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  PROCEDURE:  *) 

(*  DISPLAYS  THE  UPDATE  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  UPDATE  PANEL  (MUPDATE)  BY  MAKING  ISPLNK  CALLS.  *) 

(*  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  TYPE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  BEGIN  ^INCLUDE  NVRTVRS  *********************************************) 

(*  *) 

PROCEDURE  NVRTVRS  (  CONST  KIND  ;  INTEGER; 

VAR  RUNTIME  :  T_RUN_TIME; 

VAR  RUNTIME_SIZE  :  INTEGER; 

VAR  RETURN_CODE  :  INTEGER  ); 

SUBPROGRAM; 

(*  *) 

(*  $ FUNCTION:  *) 

(*  RETRIEVE  ENTITY  DEFINITIONS  FROM  THE  FILE  *) 


^DESCRIPTION  OF  ARGUMENTS: 


RUNTIME 


RUNTIME_SIZE 

RETURN_CODE 


DESCRIPTION  *) 

===========  *) 

THE  KIND  NUMBER  OF  THE  ENTITY  *) 

DEFINITION  TO  BE  READ  *) 

RUN-TIME  SUBSCHEMA  WHICH  CONTAINS  *) 

THE  ENTITY  DEFINITION,  ALONG  WITH  *) 

ANY  ENUMERATION  VALUES,  ANY  ARRAY  *) 

INFORMATIONS,  AND  CONSTITUENT  LIST  *) 

INFORMATIONS,  IN  A  COMPACTED  FORM.  *) 

THE  NUMBER  OF  BYTES  ACTUALLY  REQUIRED  *) 

FOR  THE  COMPACTED  RUN-TIME  SUBSCHEMA.  *) 

RETURN  CODE  *) 


^COMMONS: 


^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

NAME/VALUE  INTERFACE 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 

^PROCESSING  DESCRIPTION: 

LOOP  THROUGH  INXFILE 

IF  KIND  FOUND  IN  INXFILE  THEN 
LOOP  THROUGH  DATAFILE 

IF  KIND  FOUND  IN  DATAFILE  THEN 

STORE  ENTITY  DEFINITION  IN  TEMPORARY  WORK  AREA 
END  IF 

END  IF 
END  LOOP 

STORE  ENTITY  DEFINITION  INTO  RUN-TIME  SUBSCHEMA 
STORE  SIZE  OF  ENTITY  DEFINITION  INTO  RUN-TIME  SUBSCHEMA 
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(*  ^COMMENTS:  .. 

(*  ' 

(*  $ CHANGE  CONTROL: 

(*  ORIGINATED:  21  OCTOBER  1986,  M.  H.  CHOI,  DBMA 

(*  ' 

(*  END  %INCLUDE  NVRTVRS  ***********************************************^ 
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(*  BEGIN  %INCLUDE 


PHALFLD  *********************************************) 


(* 

PROCEDURE  PHALFLD  (  VAR  FIELD_KEY  :  ENTKEY; 

CONST  OFFSET_LIST  :  T_OFFSET_LIST ; 

CONST  OFFSET_LIST_COUNT  :  INTEGER; 

VAR  S_ROOT  :  T_STRUC_POINTER; 

VAR  ARRAY_TABLE_POSITION  :  INTEGER; 

VAR  CL_POSITION  :  INTEGER; 

VAR  ENUM_TABLE_POSITION  :  INTEGER; 

VAR  IRC  :  RETJREC  ); 

SUBPROGRAM; 

(* 

(*  $ FUNCTION: 

(*  PHYSICALIZE  THE  ATTRIBUTE  OF  AN  ENTITY 

(*  (  ASSIGN  ATTRIBUTE  SIZE  AND  LOCATION  ) 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 

(*  NAME  I/O 

(*  FIELD  JCEY  I 

(*  OFFSETJLIST  I 

(* 

(*  OFFSET_LIST_COUNT  I 

(*  S_ROOT  I/O 

(*  ARRAY_TABLE_POSIT  0 

(*  OPPOSITION  0 

(*  ENUM_TABLE_POSIT  0 

(*  IRC  0 

(* 

(*  ^COMMONS: 

<* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(*  LOOP  THROUGH  ATTRIBUTES  IN  THE  LIST  OF  BOUNDARY  ALIGNMENT" 

(*  IF  ATTRIBUTE  NAME  IS  IN  THE  LIST  THEN 

(*  OBTAIN  SIZE  AND  OFFSET  FROM  THE  LIST 

(*  PHYSICALIZE  THE  ATTRIBUTE 

(*  END  IF 

(*  END  LOOP 

(* 

(*  $ COMMENTS : 

(* 


DESCRIPTION 

FIELD  KEY  TO  BE  PHYSICALIZE 
LIST  OF  ATTRIBUTES  OF  AN  ENTITY 
ACCORDING  TO  BOUNDARY  ALIGNMENT 
NUMBER  OF  ATTRIBUTES  IN  THE  LIST 
LIST  OF  STRUCTURE  ATTRIBUTES 
NUMBER  OF  ARRAYS  IN  THE  ENTITY 
NUMBER  OF  POINTERS  IN  THE  ENTITY 
NUMBER  OF  ENUMERATIONS  IN  THE  ENTITY 
RETURN  CODE 


*) 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 
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(*  $ CHANGE  CONTROL:  *) 
(*  REVISED:  15  JANUARY  1988,  M.  H.  CHOI,  DBMA  *) 
(*  INCORPORATED  THE  STRUCTURE  DATA  TYPE  *) 
(*  ORIGINATED:  26  NOVEMBER  1986,  M.  H.  CHOI,  DBMA  *) 
(*  *) 
(*  END  %INCLUDE  PHALFLD  ***********************************************) 
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(*  BEGIN  %INCLUDE  PHALST  **********************************************) 
(*  *) 
PROCEDURE  PHALST  (  CONST  ENTITY_KEY  :  ENTKEY; 

CONST  STRUCTURE_NAME  :  T_NAME ; 

CONST  S_ROOT  :  T_STRUC_POINTER; 

VAR  ARRA Y_TABLE_P 0 S I T I ON  :  INTEGER; 

VAR  CL_P0SITI0N  :  INTEGER; 

VAR  ENUM_TABLE_POSITION  :  INTEGER; 

VAR  IRC  :  RET_REC  ); 

SUBPROGRAM; 


(*  *) 

(*  $ FUNCTION:  *) 

(*  PHYSICALIZE  THE  STRUCTURE  ATTRIBUTE  OF  AN  ENTITY  *) 

(*  (  ASSIGN  ATTRIBUTE  SIZE  AND  LOCATION  )  *) 

<*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  ENTITY_KEY  I  ENTITY  KEY  TO  BE  PHYSICALIZE  *) 


(*  STRUCTURE JNAME  I  NAME  OF  THE  STRUTURE  ATTRIBUTE  *) 

(*  S_ROOT  I/O  LIST  OF  STRUCTURE  ATTRIBUTES  *) 

(*  ARRAY_TABLE_POSIT  0  NUMBER  OF  ARRAYS  IN  THE  ENTITY  *) 

(*  OPPOSITION  0  NUMBER  OF  POINTERS  IN  THE  ENTITY  *) 

(*  ENUM_TABLE_POSIT  0  NUMBER  OF  ENUMERATIONS  IN  THE  ENTITY  *) 

(*  IRC  0  RETURN_CODE  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  LOOP  THROUGH  ATTRIBUTES  IN  THE  LIST  OF  BOUNDARY  ALIGNMENT  *) 

(*  IF  ATTRIBUTE  NAME  IS  IN  THE  LIST  THEN  *) 

(*  OBTAIN  SIZE  AND  OFFSET  FROM  THE  LIST  *) 

(*  PHYSICALIZE  THE  ATTRIBUTE  *) 

(*  END  IF  *) 

(*  END  LOOP  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  ORIGINATED:  15  JANUARY  1988,  M.  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  %INCLUDE  PHALST  ************************************************ ) 
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(*  BEGIN  %INCLUDE  PHBNST  **********************************************) 


(* 

PROCEDURE  PHBNST  ( 


*) 


CONST  NAME 
CONST  ALIGNMENT 
CONST  SIZE 


VAR 

VAR 

VAR 

VAR 

VAR 


DW_ROOT 
FW_ROOT 
HW_ROOT 
BY_R00T 
PNTR  ROOT 


T_NAME;. 

T_ALIGN; 

INTEGER; 

T_DW_PO INTER; 
T_FW_POINTER; 
T_HW_PO INTER; 
T_BY_POINTER; 
T_PNTR_POINTER ; 


VAR 

IRC 

:  RET_REC  ); 

SUBPROGRAM; 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

BUILD  A  LIST 

OF  ATTRIBUTES  IN  THE  STRUCTURE  OF  AN  ENTITY 

*) 

(* 

ACCORDING  TO 

BOUNDARY  ALIGNMENT. 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME 

I/O 

DESCRIPTION 

*) 

<* 

NAME 

I 

NAME  OF  STRUCTURE  ATTRIBUTE 

*  ) 
*) 

(* 

ALIGNMENT 

I 

ALIGNMENT  OF  STRUCTURE 

*) 

(* 

SIZE 

I 

SIZE  OF  THE  STRUCTURE 

*) 

(* 

DW_ROOT 

0 

LIST  OF  ATTRIBUTES  WHICH  REQUIRE 

FOR 

*) 

<* 

DOUBLE  WORD  ALIGNMENT 

*) 

(* 

FW_ROOT 

0 

LIST  OF  ATTRIBUTES  WHICH  REQUIRE 

FOR 

*) 

(* 

FULL  WORD  ALIGNMENT 

*) 

(* 

HW_ROOT 

0 

LIST  OF  ATTRIBUTES  WHICH  REQUIRE 

FOR 

*) 

(* 

HALF  WORD  ALIGNMENT 

*) 

(* 

BY_ROOT 

0 

LIST  OF  ATTRIBUTES  WHICH  REQUIRE 

FOR 

*) 

<* 

BYTES 

*) 

(* 

PNTRJROOT 

0 

LIST  OF  POINTER  ATTRIBUTES 

*) 

(* 

IRC 

0 

RETURN_CODE 

*) 

(* 

*) 

(* 

^COMMONS : 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

<* 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

*) 

<* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

PROCEDURE  (1)  : 

DW_ALIGNMENT 

*) 

(* 

BUILD  A  LIST 

OF  ATTRIBUTES  (  NAME  AND  SIZE  )  OF  AN  ENTITY 

*) 

(* 

REQUIRE  FOR  DOUBLE  WORD 

ALIGNMENT 

*) 

(* 

*) 
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(*  PROCEDURE  (2)  :  FW_ALIGNMENT  *) 

(*  BUILD  A  LIST  OF  ATTRIBUTES  (  NAME  AND  SIZE  )  OF  AN  ENTITY  *) 

(*  REQUIRE  FOR  FULL  WORD  ALIGNMENT  *) 

(*  *) 

(*  PROCEDURE  (3)  :  HW_ALIGNMENT  *) 

(*  BUILD  A  LIST  OF  ATTRIBUTES  (  NAME  AND  SIZE  )  OF  AN  ENTITY  *) 

(*  REQUIRE  FOR  HALF  WORD  ALIGNMENT  *) 

(*  *) 

(*  PROCEDURE  (4)  :  BY_ALIGNMENT  *) 

(*  BUILD  A  LIST  OF  ATTRIBUTES  (  NAME  AND  SIZE  )  OF  AN  ENTITY  *) 

(*  REQUIRE  FOR  BYTES  *) 

(*  *) 

(*  PROCEDURE  (5)  :  PNTR_ALI GNMENT  *) 

(*  BUILD  A  LIST  OF  POINTER  ATTRIBUTES  OF  AN  ENTITY  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION)  *) 

(*  ORIGINATED:  IS  JANUARY  1988,  M.  H.  CHOI,  DBMA  *) 

(*  *) 

(*  END  %INCLUDE  PHBNST  ************************************************) 


Cl  PS560240032U 
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(*  BEGIN  ^INCLUDE  PHBYFPOS  ********************************************) 


(* 

*) 

PROCEDURE  PHBYFPOS  (  VAR 

ORDER_INDEX  :  INTEGER; 

VAR 

ORDER_REC  :  T_GLOBAL_FIELD ; 

VAR 

ARRAY_TABLE_POSITION  :  INTEGER; 

VAR 

ENUM^.TABLE_POSITION  :  INTEGER; 

VAR 

CL_POSITION  :  INTEGER; 

VAR 

OFFSET_LI ST_COUNT  :  INTEGER; 

VAR 

OFFSET_LIST  :  T„OFFSET_LIST ; 

VAR 

IRC  •:  RET_REC  ); 

SUBPROGRAM; 

<* 

*) 

(* 

^FUNCTION: 

*) 

(* 

PHYSICALIZE  THE  . 

ATTRIBUTES  THAT  SPECIFIED  THE  FIELD 

*) 

(* 

POSITION  ORDER  ( 

DETERMINE  ATTRIBUTE  SIZE  AND  LOCATION  ) 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

/ 

NAME 

170  DESCRIPTION 

*) 
*  \ 

\ 

(* 

ORDER_INDEX 

I  NUMBER  OF  ATTRIBUTES  THAT  SPECIFIED 

*) 

<* 

THE  ORDER 

*) 

(* 

ORDER_REC 

I  LIST  OF  ATTRIBUTES  THAT  SPECIFIED 

*) 

(* 

THE  ORDER 

*) 

(* 

ARRAY_TABLE_POS 

0  NUMBER  OF  ARRAYS 

*) 

(* 

ENUMJTABLE  POSR 

0  NUMBER  OF  ENUMERATIONS 

*> 

(* 

CL_POSITION 

0  HUMBER  OF  POINTERS 

*) 

(* 

OFFSET_LIST_COUNT  0  NUMBER  OF  ATTRIBUTES  IN  THE  LIST 

*> 

(* 

OFFSET_LIST 

0  LIST  OF  ATTRIBUTES  OF  AN  ENTITY 

*) 

(* 

IRC 

0  RETURN_CQDE 

*) 

(* 

*) 

(* 

$ COMMONS: 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

*) 

(* 

HARDWARE  SYSTEM: 

IBM  360/370/4341/4381 

*) 

<* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

SORT  ATTRIBUTES 

BY  THE  FIELD  POSITION  NUMBER 

*) 

(* 

LOOP  THROUGH  THE 

ORDER  LIST 

*) 

(* 

PHYSICALIZE  THE  ATTRIBUTE 

*) 

(* 

END  LOOP 

*) 

(* 

*) 

<* 

^COMMENTS : 

*) 

(* 


*) 
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$ CHANGE  CONTROL:  *) 

ORIGINATED:  14  OCTOBER  1986,  M.  H.  CHOI,  DBMA  *) 

*) 

END  ^INCLUDE  PHBYFPOS  **********************************************) 


Cl  PS560240032U 
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(*  BEGIN  %INCLUDE  PHDECBYT  ********************************************) 
(*  *) 


PROCEDURE  PHDECBYT  (  CONST  CNST_ADB 

CONST  NAME 
CONST  ARRAY_LENGTH 
VAR  DW_ROOT 
VAR  FW_R00T 
VAR  HW_ROOT 
VAR  BY_ROOT 
VAR  PNTR_ROOT 
VAR  IRC 

SUBPROGRAM; 


ENTBLOCK; 

T_NAME; 

INTEGER; 
T_DW_POINTER; 
T_FW_PO INTER; 
T_HW_POINTER; 
T_BY_POINTER ; 
T_PNTR_PO INTER ; 
RET_REC  ) ; 


(* 

(*  $ FUNCTION: 

(*  TRANSLATE  DECIMAL  DIGIT  PRECISION  INTO  BYTE  PRECISION  AND 

(*  BUILD  A  LIST  OF  ATTRIBUTES  OF  AN  ENTITY  ACCORDING  TO 

(*  BOUNDARY  ALIGNMENT. 


(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 


(* 

NAME 

I/O 

DESCRIPTION 

(* 

==== 

=== 

ii 

ii 

ii 

n 

ii 

ii 

ii 

it 

ii 

ii 

ii 

(* 

CNST_ADB 

I 

ADB  OF  CONSTITUENT 

(* 

NAME 

I 

ATTRIBUTE  NAME 

<* 

ARRAY_LENGTH 

I 

NUMBER  OF  ARRAY  DIMENSIONS 

(* 

(* 

DW_ROOT 

0 

LIST  OF  ATTRIBUTES  WHICH  REQUIRE 
DOUBLE  WORD  ALIGNMENT 

FOR 

(* 

(* 

FW_ROOT 

0 

LIST  OF  ATTRIBUTES  WHICH  REQUIRE 
FULL  WORD  ALIGNMENT 

FOR 

(* 

(* 

HWJROOT 

0 

LIST  OF  ATTRIBUTES  WHICH  REQUIRE 
HALF  WORD  ALIGNMENT 

FOR 

<* 

(* 

BY_ROOT 

0 

LIST  OF  ATTRIBUTES  WHICH  REQUIRE 
BYTES 

FOR 

(* 

PNTR_ROOT 

0 

LIST  OF  POINTER  ATTRIBUTES 

(* 

IRC 

0 

RETURN_CODE 

(* 

(*  $ COMMONS : 

(* 

(*  ^ENVIRONMENT: 

(*  •  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

(*  .  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 


(* 

(*  ^EXECUTION  PROCEDURE: 


(* 

(*  ^PROCESSING  DESCRIPTION: 

(*  CASE  ATTRIBUTE  TYPE  OF 

(*  INTEGER  :  CASE  DECIMAL  DIGIT  OF  INTEGER  SIZE  OF 

(*  1,  2  :  BYTES_PRECISION  =  1 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 


SIZE  =  BYTES_PRECISION  *  ARRAY_LENGTH* ) 


BY_ALI GNMENT,  PROCEDURE  (4)  *) 

*) 

3,  4  :  BYTES_PRECISION  =2  *) 

SIZE  =  BYTES_PRECISION  *  ARRAY_LENGTH* ) 
HW_ALIGNMENT,  PROCEDURE  (3)  *) 

*) 

5,  6,:  BYTE S_PRE C I S I ON  =  4  *) 

7,  8,  SIZE  =  BYTES_PRECISION  *  ARRAY_LENGTH* ) 

9  REALIGNMENT,  PROCEDURE  (2)  *) 

*) 

REAL  :  CASE  DECIMAL  DIGIT  OF  REAL  SIZE  OF  *) 

1,2,3:  BYTES_PRECISION  =4  *) 

4,5,6  SIZE  =  BYTES_PRECISION  *  ARRAY_LENGTH* ) 
7  FW_ALIGNMENT,  PROCEDURE  (2)  *) 

*) 

8,  9,  10,  11,  *) 

12,  13,  14,  15,  *) 

16  :  BYTES_PRECISION  =8  *) 

SIZE  =  BYTES JPRECISION  *  ARRAYJLENGTH  *) 
DW_ALIGNMENT,  PROCEDURE  (1)  *) 

*) 

STRING  :  BYTESJPRECISION  =  DECIMAL  SIZE  OF  STRING  *) 

SIZE  =  BYTES_PRECI S I ON  *  ARRAY_LENGTH  *) 

BY_ALIGNMENT,  PROCEDURE  (4)  *) 

*) 

LOGICAL,  *) 

ENUMERATION  :  BYTES_PRECISION  =1  *) 

SIZE  =  BYTES_PRECISION  *  ARRAY_LENGTH  *) 

BY_ALIGNMENT,  PROCEDURE  (4)  *) 

*) 

POINTER  :  BYTES_PRECISION  =0  *) 

SIZE  =BYTES_PRECISION  *  ARRAY_LENGTH  *) 

PNTR_ALI GNMENT ,  PROCEDURE  (5)  *) 

*) 

END  CASE  *) 

PROCEDURE  (1)  :  DW_ALI GNMENT  *) 

BUILD  A  LIST  OF  ATTRIBUTES  (  NAME  AND  SIZE  )  OF  AN  ENTITY  *) 
REQUIRE  FOR  DOUBLE  WORD  ALIGNMENT  *) 

*) 

PROCEDURE  (2)  :  FW_ALI GNMENT  *) 

BUILD  A  LIST  OF  ATTRIBUTES  (  NAME  AND  SIZE  )  OF  AN  ENTITY  *) 
REQUIRE  FOR  FULL  WORD  ALIGNMENT  *) 

*) 

PROCEDURE  (3)  :  HW_ALI GNMENT  *) 

BUILD  A  LIST  OF  ATTRIBUTES  (  NAME  AND  SIZE  )  OF  AN  ENTITY  *) 
REQUIRE  FOR  HALF  WORD  ALIGNMENT  *) 

*) 
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(*  PROCEDURE  (4)  :  BY_ALIGNMENT  *) 

(*  BUILD  A  LIST  OF  ATTRIBUTES  (  NAME  AND  SIZE  )  OF  AN  ENTITY  *) 

(*  REQUIRE  FOR  BYTES  *) 

(*  *) 

(*  PROCEDURE  (5)  :  PNTR_ALIGNMENT  *) 

(*  BUILD  A  LIST  OF  POINTER  ATTRIBUTES  OF  AN  ENTITY  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION)  *) 

(*  ORIGINATED:  25  AUGUST  1986,  M.  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  %INCLUDE  PHDECBYT  **********************************************) 
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(*  BEGIN  %INCLUDE  PHENTITY 
(* 

PROCEDURE  PHENTITY  (  VAR 

VAR 

VAR 

VAR 

VAR 

VAR 

VAR 

VAR 


********************************************) 

*) 

ENTITYJCEY  :  ENTKEY; 

ARRAY_TABLE_POSITION  :  INTEGER; 
ENUM_TABLE_POSITION  :  INTEGER; 

CL_POSITION  :  INTEGER; 

OFFSET_LIST_COUNT  :  INTEGER; 

OFFSET_LIST  :  T_OFFSET_LIST; 

ADB_SIZE  :  INTEGER; 

IRC  :  RET_REC  ); 


SUBPROGRAM; 

(*  *) 
(*  $ FUNCTION:  *) 

(*  PHYSICALIZE  THE  ENTITY  DEFINITIONS  OF  THE  SUBSCHEMA  *) 

(*  (  DETERMINE  ATTRIBUTE  SIZE  AND  LOCATION  )  *) 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 


^DESCRIPTION  OF  ARGUMENTS: 

NAME  I/O  DESCRIPTION 


ENTITY  JOEY  I 

ARRAY_TABLE_POS IT  0 

enumjtablejposit  0 

CL_TABLE_POSIT  0 
OFFSET_LIST_COUNT  0 
OFFSET_LIST  0 

NEW_SIZE  0 

IRC  0 


ENTITY  KEY  OF  DEFINITION  TO  BE 

PHYSICALIZE 

NUMBER  OF  ARRAYS 

NUMBER  OF  ENUMERATIONS 

NUMBER  OF  POINTERS 

NUMBER  OF  ATTRIBUTES  IN  THE  LIST 

LIST  OF  ATTRIBUTES  OF  AN  ENTITY 

SIZE  DIFFERENCE  BETWEEN  THE  PREVIOUS 

TOTAL  GLOBAL  SIZE  AND  THE  NEW  TOTAL 

GLOBAL  SIZE 

RETURN_CODE 


$ COMMONS: 


^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 
HARDWARE  SYSTEM:  IBM  360/370/4341/4381 


^EXECUTION  PROCEDURE: 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*> 

*) 

*) 


*> 

^PROCESSING  DESCRIPTION:  *) 

LOOP  THROUGH  THE  ATTRIBUTES  THAT  SPECIFIED  THE  ORDER  *) 

PHYSICALIZE  THE  ATTRIBUTES  *) 

END  LOOP  *) 

LOOP  THROUGH  THE  ATTRIBUTES  THAT  DID  NOT  SPECIFIED  THE  ORDER*) 

PHYSICALIZE  THE  ATTRIBUTES  *) 

END  LOOP  *) 

*) 
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(*  $ COMMENTS :  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 
(*  ORIGINATED:  4  SEPTEMBER  1987,  M.  H.  CHOI,  DBMA  *) 
(*  *) 


(*  END  %INCLUDE  PHENTITY  **********************************************) 
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(*  BEGIN  %INCLUDE  PHGLOBAL  ********************************************) 
(*  *) 


PROCEDURE  PHGLOBAL  (  VAR 

VAR 

VAR 

VAR 

VAR 

VAR 

VAR 


LIST_OF_GLOBALS  :  LISTKEY; 
ARRAY_TABLE_POSITION  :  INTEGER; 
ENUM_TABLE_POSITION  :  INTEGER; 
CL_TABLE_POS ITI ON  :  INTEGER; 
OFFSET_LIST_COUNT :  INTEGER; 
OFFSET_LIST  :  T_OFFSET_LI ST ; 

IRC  :  RET_REC  ); 


SUBPROGRAM; 


(* 

(*  $ FUNCTION: 

(*  PHYSICALIZE  THE  GLOBAL  FIELDS  OF  THE  SCHEMA 

(*  (  DETERMINE  ATTRIBUTE  SIZE  AND  LOCATION  ) 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 

(*  NAME  I/O 

(*  SUBSCHEMAJCEY  I 

(*  ARRAY_TABLE_POSIT  0 

(*  ENUM_TABLE_POSIT  0 

<*  CL_TABLE_POSIT  0 

(*  OFFSET_LIST_COUNT  0 

(*  OFFSET_LIST  0 

(* 

(*  IRC  0 

(* 

(*  $ COMMONS : 

(* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(*  IF  THERE  ARE  ANY  GLOBAL  FIELDS  THEN 

(*  LOOP  THROUGH  EACH  GLOBAL  FIELDS 

(*  DETERMINE  THE  FIELD  POSITION  NUMBER 

(*  END  LOOP 

(*  LOOP  THROUGH  THE  FIELDS  WITH  FIELD  POSITION 

(*  PHYSICALIZE  THE  FIELD  BY  FIELD  POSITION  NUMBER 

(*  END  LOOP 

(*  LOOP  THROUGH  THE  FIELDS  WITHOUT  THE  FIELD  POSITION 

(*  PHYSICALIZE  THE  FIELD  BY  BOUNDARY  ALIGNMENT 

(*  END  LOOP 

(* 


DESCRIPTION 

SUBSCHEMA  KEY 

NUMBER  OF  ARRAYS 

NUMBER  OF  ENUMERATIONS 

NUMBER  OF  POINTERS 

NUMBER  OF  ATTRIBUTES  IN  THE  LIST 

LIST  OF  ATTRIBUTES  OF  AN  ENTITY 

ACCORDING  TO  BOUNDARY  ALIGNMENT 

RETURN  CODE 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*> 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  ^COMMENTS:  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 
C*  ORIGINATED:  25  NOVEMBER  1986,  M.  H.  CHOI,  DBMA  *) 
(*  *) 


(*  END  %INCLUDE  PHGLOBAL  **********************************************) 
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(*  BEGIN  %INCLUDE  PHGTFLD 
(* 

PROCEDURE  PHGTFLD 


*********************************************  } 

*) 


(* 

(* 

(* 

(* 

(* 

(* 


CONST 

FIELD_KEY 

ENTKEY; 

CONST 

FIELD_NAME 

T_NAME; 

VAR 

S_ROOT 

T_STRUC_PO INTER; 

VAR 

DW_ROOT 

T_DW_POINTER ; 

VAR 

FW_ROOT 

T_FW_PO INTER; 

VAR 

HW_ROOT 

T_HW_PO INTER; 

VAR 

BY_ROOT 

T_BY_POINTER ; 

VAR 

PNTR_ROOT 

T_PNTR_PQINTER ; 

VAR 

NO_OF_DIMENS 

INTEGER; 

VAR 

LOW_BOUND 

T_LOW_BOUND ; 

VAR 

HIGH_BOUND 

T_HIGH_BOUND; 

VAR 

CL_POSITION 

INTEGER; 

VAR 

IRC 

RET_REC  ); 

SUBPROGRAM; 

^FUNCTION: 

DETERMINE  THE 
IN  THE  FIELD 


BOUNDARY  ALIGNMENT  OF  DIFFERENT  DATA  TYPES 


^DESCRIPTION  OF  ARGUMENTS: 


*) 

*) 

*) 

*) 

*) 


(* 

NAME 

I/O 

DESCRIPTION 

*) 

(* 

===== 

===== 

it 

n 

ii 

ii 

ii 

ii 

ii 

it 

ii 

ii 

n 

*) 

(* 

FIELD_KEY 

I 

FIELD  KEY  TO  DETERMINE  THE  DATA  TYPE 

*) 

(* 

AND  THE  BOUNDARY  ALIGNMENT 

*) 

<* 

FIELD_NAME 

I 

ATTRIBUTE  NAME 

*) 

(* 

DW_ROOT 

0 

LIST  OF  ATTRIBUTES  WHICH  REQUIRE 

FOR 

*) 

(* 

DOUBLE  WORD  ALIGNMENT 

*) 

<* 

FW_ROOT 

0 

LIST  OF  ATTRIBUTES  WHICH  REQUIRE 

FOR 

*) 

(* 

FULL  WORD  ALIGNMENT 

*) 

(* 

HW_ROOT 

0 

LIST  OF  ATTRIBUTES  WHICH  REQUIRE 

FOR 

*) 

(* 

HALF  WORD  ALIGNMENT 

*) 

(* 

BY_ROOT 

0 

LIST  OF  ATTRIBUTES  WHICH  REQUIRE 

FOR 

*) 

<* 

BYTES 

*) 

<* 

PNTR_ROOT 

0 

LIST  OF  POINTER  ATTRIBUTES 

*) 

(* 

NO_OF_DIMENS 

0 

NUMBER  OF  ARRAY  DIMENSIONS 

*) 

(* 

LOW_BOUND 

0 

LIST  OF  LOWER  BOUNDS  IN  ARRAY 

*) 

(* 

ATTRIBUTE 

*) 

(* 

HIGH_BOUND 

0 

LIST  OF  HIGH  BOUNDS  IN  ARRAY 

*) 

(* 

ATTRIBUTE 

*) 

(* 

IRC 

0 

RETURN.CODE 

*) 

(* 

*) 

<* 

^COMMONS : 

*) 

(* 

*) 
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(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DETERMINE  THE  FIELD  BOUNDARY  ALIGNMENT  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  ORIGINATED:  26  NOVEMBER  1986,  M.  H.  CHOI,  DBMA  *) 

(*  *) 

(*  END  ^INCLUDE  PHGTFLD  ***********************************************) 
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(*  BEGIN  %INCLUDE  PHGTST  **********************************************) 


(* 

*) 

PROCEDURE  PHGTST  (  CONST  ENTITYJOSY 

ENTKEY; 

CONST  STRUCTURE_NAME 

T_NAME; 

VAR  STRUCTURE_R00T 

T_STRUC_POINTER ; 

VAR  STRUCTURE_SIZE 

INTEGER; 

VAR  STRUCTURE_ALIGN 

T_ALIGN; 

VAR  CL_POSITION 

INTEGER; 

VAR  IRC 

RET_REC  ); 

SUBPROGRAM; 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

DETERMINE  THE  BOUNDARY  ALIGNMENT  OF  STRUCTURE  DATA  TYPE 

*) 

(* 

IN  THE  FIELD 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME  I/O  DESCRIPTION 

*) 

(* 

ii 

ii 

ii 

ii 

ii 

n 

ii 

ii 

ii 

ii 

ii 

ii 

n 

ii 

ii 

ii 

n 

= 

*) 

(* 

ENTITY JCEY  I  ENTITY  KEY 

TO  DETERMINE  THE  DATA 

*) 

(* 

TYPE  AND  THE  BOUNDARY  ALIGNMENT 

*) 

(* 

STRUCTURE_NAME  I  NAME  OF  STRUCTURE 

*) 

(* 

STRUCTURE JROOT  0  LIST  OF  STRUCTURE  ATTRIBUTES 

*) 

(* 

STRUCTURE_S I ZE  0  SIZE  OF  THE  STRUCTURE 

*) 

(* 

STRUCTURE_ALIGN  0  STRUCTURE  ALIGNMENT 

*) 

(* 

IRC  0  RETURN_CODE 

*) 

(* 

*) 

(* 

^COMMONS : 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

DETERMINE  THE  STRUCTURE  FIELD  BOUNDARY  ALIGNMENT 

*) 

(* 

*) 

<* 

^COMMENTS : 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

<* 

ORIGINATED:  15  JANUARY  1988,  M.  H 

CHOI,  DBMA 

*) 

(* 

*) 

(* 

END  ^INCLUDE  PHGTST  ************************************************) 
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(* 

BEGIN  %INCLUDE  PHPOSITN 

********************************************) 

(* 

*) 

PROCEDURE  PHPOSITN  (  CONST 

LIST_OF_FIELDS  :  LISTKEY; 

VAR 

ORDER.INDEX  :  INTEGER; 

VAR 

ORDER_REC  :  T_GLOBAL_FIELD ; 

VAR 

UNORDER_LIST  :  LISTKEY; 

VAR 

IRC  :  RET_REC  ); 

SUBPROGRAM; 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

DETERMINE  THE  FIELD  POSITION  ORDER 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME 

I/O  DESCRIPTION 

*) 

* 

(* 

LIST_OF_FIELDS 

I  FIELDS  TO  DETERMINE  THE  FIELD 

) 

*) 

(* 

POSITION  ORDER 

*) 

(* 

ORDER_INDEX 

0  NUMBER  OF  ATTRIBUTES  THAT  SPECIFIED 

*) 

(* 

THE  FIELD  POSITION  NUMBER 

*) 

(* 

ORDER_REC 

0  LIST  OF  ATTRIBUTES  THAT  SPECIFIED 

*) 

(* 

THE  FIELD  POSITION  NUMBER 

*) 

(* 

UNORDER_LIST 

0  LIST  OF  ATTRIBUTES  THAT  DID  NOT 

*) 

(* 

SPECIFIED  THE  ORDER 

*) 

c* 

IRC 

0  RETURN_CODE 

*) 

<* 

*) 

(* 

^COMMONS : 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

*) 

(* 

HARDWARE  SYSTEM: 

IBM  360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

LOOP  THROUGH  THE 

ATTRIBUTES 

*) 

(* 

IF  ATTRIBUTE 

DID  NOT  SPECIFIED  THE  POSITION  THEN 

*) 

(* 

ATTACH  TO 

THE  UNORDER  LIST 

*) 

(* 

ELSE 

*) 

<* 

ATTACH  TO 

THE  ORDER  LIST 

*) 

(* 

END  LOOP 

*> 

(* 

*) 

(* 

^COMMENTS : 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

<* 

ORIGINATED:  14  OCTOBER  1986,  M.  Hr  CHOI,  DBMA 

*) 

(* 

*) 

(*  END  XINCLUDE  PHPOSITN  ******************************************#***) 
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(*  BEGIN  %INCLUDE  PHSRTFLD  ********************************************) 
(*  *) 
PROCEDURE  PHSRTFLD  (  VAR  DW_ROOT  :  T_DW_POINTER; 

VAR  FW_ROOT  :  T_FW_PO INTER; 

VAR  HW_ROOT  :  T_HW_POINTER; 

VAR  BY_ROOT  :  i_BY_POipER; 

VAR  PNTR_ROOT  :  T_PNTR_POINTER ; 

VAR  OFFSET_LIST  :  T_OFFSET_LIST; 

VAR  TOTAL_COUNT  :  INTEGER; 

VAR  CL_POSITION  :  INTEGER  ); 

SUBPROGRAM; 


(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

<* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

<* 

(* 


$ FUNCTION:  *) 

DETERMINE  THE  LOCATION  OF  ATTRIBUTES  OF  AN  ENTITY  ACCORDING  *) 
TO  BOUNDARY  ALIGNMENT.  *) 

^DESCRIPTION  OF  ARGUMENTS:  *) 

NAME  I/O  DESCRIPTION  *) 

DW_ROOT  I  LIST  OF  ATTRIBUTES  WHICH  REQUIRE  FOR  *) 

DOUBLE  WORD  ALIGNMENT  *) 

FW.ROOT  I  LIST  OF  ATTRIBUTES  WHICH  REQUIRE  FOR  *) 

FULL  WORD  ALIGNMENT  *) 

HW.ROOT  I  LIST  OF  ATTRIBUTES  WHICH  REQUIRE  FOR  *) 

HALF  WORD  ALIGNMENT  *) 

BY_ROOT  I  LIST  OF  ATTRIBUTES  WHICH  REQUIRE  FOR  *) 

BYTES  *) 

PNTR_ROOT  I  LIST  OF  POINTER  ATTRIBUTES  *) 

OFFSET_LIST  0  LIST  OF  ATTRIBUTES  OF  AN  ENTITY  *) 

ACCORDING  TO  BOUNDARY  ALIGNMENT  *) 

TOTAL_COUNT  0  NUMBER  OF  ENTRIES  IN  THE  LIST  *) 

*) 

$ COMMONS: 

*) 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 


^EXECUTION  PROCEDURE: 


^PROCESSING  DESCRIPTION:  *) 

LOOP  THROUGH  EACH  LIST  OF  ALIGNMENTS  TABLE  ACCORDING  TO  *) 
BOUNDARY  ALIGNMENT  *) 

(1)  LIST  OF  DOUBLE  WORD  ALIGNMENT  *) 

(2)  LIST  OF  FULL  WORD  ALIGNMENT  *) 

(3)  LIST  OF  HALF  WORD  ALIGNMENT  *) 

(4)  LIST  OF  BYTE  ALIGNMENT  *) 
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(*  STORE  ATTRIBUTE  NAME  AND  SIZE  INTO  LIST  OF  OFFSET-LIST  *) 

(*  TABLE  *) 

(*  IF  ATTRIBUTE  NAME  AND  SIZE  ARE  THE  FIRST  ONE  TO  STORE  *) 

(*  OFFSET  =12  *) 

(*  ELSE  *) 

(*  OFFSET  =  PREVIOUS  OFFSET  +  PREVIOUS  SIZE  *) 

(*  INCREMENT  NUMBER  OF  ENTRIES  IN  THE  TABLE  *) 

(*  END  LOOP  *) 

(*  *) 

(*  $ COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION)  *) 

(*  ORIGINATED:  18  SEPTEMBER  1986,  M.  H.  CHOI,  DBMA  *) 

(*  *) 

(*  END  %INCLUDE  PHSRTFLD  *********************************************) 
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(*  BEGIN  %INCLUDE  PHSRTORD  ********************************************) 


(*  *) 

PROCEDURE  PHSRTORD  (  CONST  ORDER_INDEX  :  INTEGER; 

VAR  ORDER_REC  :  T_GLOBAL_FIELD  ); 

SUBPROGRAM; 

(*  *) 

(*  $ FUNCTION:  *) 

(*  SORT  ATTRIBUTES  BY  THE  FIELD  POSITION  NUMBER  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  ORDER_INDEX  I  NUMBER  OF  ATTRIBUTES  THAT  SPECIFIED  *) 

(*  THE  FIELD  POSITION  NUMBER  *) 

(*  ORDER_REC  0  LIST  OF  ATTRIBUTES  THAT  SPECIFIED  *) 

(*  THE  FIELD  POSITION  NUMBER  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  LOOP  THROUGH  LIST  OF  ATTRIBUTES  THAT  SPECIFIED  THE  FIELD  *) 

(*  POSITION  NUMBER  AND  PUT  THEM  IN  ASCENDING  ORDER.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  ORIGINATED:  18  NOVEMBER  1986,  M.  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  %INCLUDE  PHSRTORD  **********************************************) 
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(*  BEGIN  %INCLUDE  PHSUBTYP  ********************************************) 
(*  *) 
PROCEDURE  PHSUBTYP  (  CONST  SUBTYPE_KEY  :  ENTKEY; 


VAR 

ARRAY_TABLE_ 

.POSITION  :  INTEGER; 

VAR 

ENUM_TABLE_POSITION  :  INTEGER; 

VAR 

CL_POSITION 

:  INTEGER; 

VAR 

OFFSET_LIST_ 

.COUNT  :  INTEGER; 

VAR 

OFFSET_LIST 

:  T_OFFSET_LIST ; 

VAR 

IRC 

:  RET_REC  ); 

SUBPROGRAM; 


(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

PHYSICALIZE  THE  SUPER 

TYPES 

*) 

(* 

(  DETERMINE  ATTRIBUTE 

SIZE  AND  LOCATION  ) 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME  I/O 

DESCRIPTION 

*) 
*  N 

V* 

(* 

SUBS  CHEMA_KEY  I 

SUBSCHEMA  KEY  OF  THE  ENTITY 

*> 

(* 

DEFINITIONS  TO  BE  PHYSICALIZE 

*) 

(* 

ARRAY_TABLE_PO  S IT  0 

NUMBER  OF  ARRAYS 

*> 

(* 

ENUM_TABLE_POSIT  0 

NUMBER  OF  ENUMERATIONS 

*> 

(* 

CL_TABLE_POSIT  0 

NUMBER  OF  POINTERS 

*) 

(* 

OFFSET_LI ST_COUNT  0 

NUMBER  OF  ATTRIBUTES  IN  THE 

LIST 

*) 

(* 

OFFSET_LIST  0 

LIST  OF  ATTRIBUTES  OF  AN  ENTITY 

*) 

(* 

NEW_SIZE  0 

SIZE  DIFFERENCE  BETWEEN  THE 

PREVIOUS 

*) 

(* 

TOTAL  GLOBAL  SIZE  AND  THE  NEW  TOTAL 

*> 

(* 

GLOBAL  SIZE 

*) 

(* 

IRC  0 

RETURN.CODE 

*> 

C* 

*> 

(* 

^COMMONS : 

*> 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

(SEGMENT  SUBPROGRAM) 

*> 

(* 

HARDWARE  SYSTEM:  IBM 

360/370/4341/4381 

*> 

(* 

*) 

<* 

^EXECUTION  PROCEDURE: 

*> 

<* 

*> 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

PHYSICALIZE  THE  ATTRIBUTES  WITHIN  THE  SUPERTYPE 

*) 

(* 

*> 

<* 

$ COMMENTS : 

*) 

(* 

*> 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

ORIGINATED:  4  SEPTEMBER  1987,  M.  H.  CHOI,  DBMA 

*) 

(* 

*) 

<* 

END  %INCLUDE  PHSUBTYP  **********************************************) 
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(*  BEGIN  %INCLUDE  PHWOFPOS  ********************************************) 

(A  *) 

PROCEDURE  PHWOFPOS  (  VAR  UNORDER_LIST  :  LISTKEY; 

VAR  ARRAY_TABLE_POSITION  :  INTEGER; 

VAR  ENUM_TABLE_POSITION  :  INTEGER; 

VAR  OPPOSITION  :  INTEGER; 

VAR  OFFSET_LIST_COUNT  :  INTEGER; 

VAR  OFFSET_LIST  :  T_OFFSET_LIST; 

VAR  IRC  :  RET_REC  ); 

SUBPROGRAM; 


(*  *) 

(*  $ FUNCTION:  *) 

(*  PHYSICALIZE  THE  ATTRIBUTES  THAT  DID  NOT  SPECIFIED  THE  *) 

(*  FIELD  POSITION  NUMBER  (  DETERMINE  ATTRIBUTE  SIZE  AND  *) 

(*  LOCATION  )  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  UNORDER_LIST  0  LIST  OF  ATTRIBUTES  WITHOUT  THE  FIELD  *) 

(*  POSITION  NUMBER  *) 

(*  ARRAY_TABLE_POS  0  NUMBER  OF  ARRAYS  *) 

(*  ENUM_TABLE_POSR  0  NUMBER  OF  ENUMERATIONS  *) 

(*  OPPOSITION  0  NUMBER  OF  POINTERS  *) 

(*  OFFSET_LIST_COUNT  0  NUMBER  OF  ATTRIBUTES  IN  THE  LIST  *) 

(*  OFFSET_LIST  0  LIST  OF  ATTRIBUTES  OF  AN  ENTITY  *) 


(*  IRC  0  RETURN_CODE  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

<*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  LOOP  THROUGH  THE  ATTRIBUTES  THAT  DID  NOT  SPECIFIED  THE  *) 

(*  FIELD  POSITION  NUMBER  *) 

(*  PHYSICALIZE  THE  ATTRIBUTE  *) 

(*  END  LOOP  *) 

<*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  ORIGINATED:  14  OCTOBER  1986,  M.  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  %INCLUDE  PHWOFPOS  **********************************************) 
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(*  BEGIN  %INCLUDE  PHYSICAL  ********************************************) 


(*  *) 
PROCEDURE  PHYSICAL  (  VAR  SUBSCHEMAJCEY  :  ENTKEY; 

VAR  IRC  :  RET.REC  ); 

SUBPROGRAM; 

(*  *) 

(*  $ FUNCTION:  *) 

(*  PHYSICALIZE  THE  ENTITY  DEFINITIONS  OF  THE  SUBSCHEMA  *) 

(*  (  DETERMINE  ATTRIBUTE  SIZE  AND  LOCATION  )  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  SUBSCHEMAJCEY  I  SUBSCHEMA  KEY  OF  THE  ENTITY  *) 

(*  DEFINITIONS  TO  BE  PHYSICALIZE  *) 

(*  IRC  0  RETURN_CODE  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

<*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  PHYSICALIZE  THE  GLOBAL  FIELDS  *) 

(*  LOOP  THROUGH  LIST  OF  ENTITIES  *) 

(*  CREATE  A  LIST  OF  SUPERTYPES  INCLUSIVELY  BY  SUPERTYPE  *) 

(*  KIND  FOR  SPECIFIC  ENTITY  *) 

(*  LOOP  THROUGH  LIST  OF  SUPERTYPES  *) 

(*  PHYSICALIZE  THE  SUPERTYPES  *) 

(*  END  LOOP  *) 

(*  PHYSICALIZE  THE  ATTRIBUTES  *) 

(*  END  LOOP  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  REVISED:  9  SEPTEMBER  1987,  M.  H.  CHOI,  DBMA  *) 

(*  ADDED  A  SUPERTYPE  *) 

(*  ORIGINATED:  14  OCTOBER  1986,  M.  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  %INCLUDE  PHYSICAL  **********************************************) 
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(*  BEGIN  %INCLUDE  PSGTSM  **********************************************) 

(*  *) 
PROCEDURE  PSGTSM  (  CONST  ENTITY_KSY  :  ENTKEY: 

VAR  RUN_TIME  :  P_RUN_TIME; 

VAR  RUN_TI ME_S I ZE  :  INTEGER; 

VAR  IRC  :  RET_REC  ); 

SUBPROGRAM; 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

<* 

(* 

<* 

(* 

(* 

(* 


$ FUNCTION:  *) 

BUILD  RUN-TIME  SUBSCHEMA  FROM  SCHEMA  MODEL  FOR  *) 

THE  PHYSICAL  SCHEMA  REPORT.  *) 

^DESCRIPTION  OF  ARGUMENTS:  *) 

NAME  I/O  DESCRIPTION  *) 

ENTITYJCEY  I  KEY  FROM  SCHEMA  MODEL  WHICH  THE  *) 

TRANSLATION  WILL  BE  PERFORMED.  *) 

IRC  0  RETURN  CODE  *) 

=  0  SUCCESS  *) 

>  0  CRITICAL  ERROR:  *) 

RUN_TIME  0  RUN-TIME  SUBSCHEMA  WHICH  CONTAINS  THE  *) 

ENTITY  DEFINITION,  ALONG-  WITH  ANY  *) 

ENUMERATION  VALUES,  CONSTITUENT  LIST,  *) 

AND  ARRAY  INFORMATION,  IN  A  COMPACTED  *) 

FORM.  *) 

RUN_TIME_S I ZE  0  THE  NUMBER  OF  BYTES  ACTUALLY  REQUIRED  *) 

FOR  THE  COMPACTED  RUN-TIME  SUBSCHEMA.  *) 


$ COMMONS : 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 
HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

RUN-TIME  SUBSCHEMA 

CALLED  FROM  THE  NAME/VALUE  INTERFACE 


^PROCESSING  DESCRIPTION:  *) 

TRANSLATE  SCHEMA  MODEL  ENTRY  INTO  ENTITY  ATTRIBUTES  *) 

AND  ENUMERATION  VALUES  AND  ARRAY  INFORMATION  *) 

IF  THERE  WERE  ANY  ENUMERATION  ATTRIBUTES  THEN  *) 

CALCULATE  THE  STARTING  POSITION  OF  THE  ENUMERATION  *) 

INDEX  TABLE  AND  STORE  INTO  RUN-TIME  SUBSCHEMA  *) 

DETERMINE  THE  ACTUAL  SIZE  OF  THE  ENUMERATION  INDEX  TABLE  *) 
COPY  ENUMERATION  INDEX  TABLE  INFORMATION  INTO  RUN-TIME  *) 

SUBSCHEMA  *) 
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(*  ENDIF  *) 
(*  IF  THERE  WERE  ANY  ENUMERATION  ATTRIBUTES  THEN  *) 
(*  CALCULATE  THE  STARTING  POSITION  OF  THE  ENUMERATION  *) 
(*  VALUE  TABLE  AND  STORE  INTO  RUN-TIME  SUBSCHEMA  *) 
(*  DETERMINE  THE  ACTUAL  SIZE  OF  THE  ENUMERATION  VALUE  TABLE  *) 
(*  COPY  THE  ENUMERATION  VALUES  INTO  THE  RUN-TIME  SUBSCHEMA  *) 
(*  ENDIF  *) 
(*  IF  THERE  WERE  ANY  ARRAY  ATTRIBUTES  THEN  *) 
(*  CALCULATE  THE  STARTING  POSITION  OF  THE  ARRAY  INDEX  TABLE  *) 
(*  AND  STORE  INTO  RUN-TIME  SUBSCHEMA  *) 
(*  DETERMINE  THE  ACTUAL  SIZE  OF  THE  ARRAY  INDEX  TABLE  *) 
(*  COPY  ARRAY  TABLE  INDEX  INFORMATION  INTO  RUN-TIME  SUBSCHEM*) 
(*  ENDIF.  *) 
(*  IF  THERE  WERE  ANY  ARRAY  ATTRIBUTES  THEN  *) 
(*  CALCULATE  THE  STARTING  POSITION  OF  THE  ARRAY  LIST  TABLE  *) 
(*  AND  STORE  INTO  RUN-TIME  SUBSCHEMA  *) 
(*  DETERMINE  THE  ACTUAL  SIZE  OF  THE  ARRAY  LIST  TABLE  *) 
(*  COPY  ARRAY  LIST  INFORMATION  INTO  RUN-TIME  SUBSCHEMA  *) 
(*  ENDIF  *) 
(*  CALCULATE  THE  SIZE  OF  THE  RUN-TIME  SUBSCHEMA  *) 
(*  *) 
(*  ^COMMENTS:  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 
(*  ORIGINATED:  25  JANUARY  1988,  M.  H.  CHOI,  DBMA  *) 
(*  *) 
(*  END  %INCLUDE  PSGTSM  ************************************************) 
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) 


(*  BEGIN  % INCLUDE  PSMASKND  ********************************************) 


(*  *) 

PROCEDURE  PSMASKND  (  VAR  ENTITY  :  P_SCHEMA  ); 

SUBPROGRAM; 

(*  *) 

(*  $ FUNCTION:  *) 

(*  INSERT  THE  MODEL  ACCESS  SOFTWARE (MAS)  ATTRIBUTES  (  KIND,  *) 

(*  LENGTH,  SYSUSE  )  INTO  A  RUN-TIME  SUBSCHEMA  FOR  THE  *) 

(*  PHYSICAL  SCHEMA  REPORT.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  .  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  ENTITY  0  RUN-TIME  SUBSCHEMA  ENTITY  DEFINITION.*) 

(*  *) 

(*  $ COMMONS :  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  $ EXE CUT I ON  PROCEDURE:  *) 

(*  NAME/VALUE  INTERFACE  *) 

(*  CALLED  FROM  THE  NAME/VALUE  INTERFACE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  INSERT  KIND,  LENGTH,  SYSUSE  ATTRIBUTES  INTO  A  RUN-TIME  *) 

(*  SUBSCHEMA  ENTITY  DEFINITION.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION)  *) 

(*  ORIGINATED:  25  JANUARY  1988,  M.  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  %INCLUDE  PSMASKND  **********************************************) 
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(*  BEGIN  ^INCLUDE  PSORDER  *********************************************) 


(*  *) 

PROCEDURE  PSORDER  (  CONST  RUNTIME  :  P_RUN_TIME; 

VAR  PS_ORDER  :  T_PS_ORDER  ); 

SUBPROGRAM; 

(*  *) 

(*  $ FUNCTION:  *) 

(*  DETERMINE  THE  PHYSICAL  SCHEMA  ORDER  OF  ENTITY  DEFINITION  *) 

(*  BY  ITS  OFFSET  FOR  THE  PHYSICAL  SCHEMA  REPORT.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  RUNTIME  I  CONTAINS  THE  ENTITY  DEFINITION  *) 

(*  PS_0RDER  0  LIST  OF  ATTRIBUTES  IN  PHYSICAL  *) 

(*  ORDER  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  LOOP  THROUGH  THE  NUMBER  OF  ATTRIBUTES  IN  THE  DEFINITION  *) 

(*  INSERT  THE  OFFSET  IN  THE  PHYSICAL  SCHEMA  ORDER  TABLE  *) 

(*  END  LOOP  *) 

(*  LOOP  THROUGH  THE  NUMBER  OF  ATTRIBUTES  IN  THE  DEFINITION  *) 

(*  IF  CURRENT  OFFSET  GREATER  THAN  NEXT  OFFSET  THEN  *) 

(*  SWITCH  CURRENT  OFFSET  WITH  NEXT  OFFSET  *) 

(*  END  IF  *) 

(*  END  LOOP  *, 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  ORIGINATED:  26  JANUARY  1988,  M.  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  %INCLUDE  PSORDER  ***********************************************) 
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(*  BEGIN  ^INCLUDE  PSRABNDS  ********************************************) 
(*  *) 
PROCEDURE  PSRABNDS  (  VAR  PSRDATA  :  TEXT; 

CONST  NO_OF_DIMEN  :  INTEGER; 

CONST  STARTING_ARRAY_POSITION  :  INTEGER; 

VAR  POINTER  :  T_VARIANT_POINTER; 

VAR  ENUM_INDEX  :  INTEGER  ); 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


SUBPROGRAM; 

^FUNCTION: 

WRITE  LOW-BOUND  AND  UPPER-BOUND  FOR  THE  ARRAY  ATTRIBUTE 

^DESCRIPTION  OF  ARGUMENTS: 

NAME  I/O  DESCRIPTION 


PSRDATA 

NO_OF_DIMENS 

STARTING_ARRAY_PO 

POINTER 


*) 

*) 

*) 

*) 

*) 

*) 

*) 


PHYSICAL  SCHEMA  REPORT  SEQUENTIAL  FILE*) 


NUMBER  OF  ARRAY  DIMENSIONS 
STARTING  POSITION  IN  THE  ARRAY  TABLE 
POINTER  TO  ARRAY  INFORMATION  TABLE 


^COMMONS : 


^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 

^PROCESSING  DESCRIPTION: 

LOOP  THROUGH  THE  NUMBER  OF  DIMENSIONS 
WRITE  LOW-BOUND  AND  UPPER-BOUND 
END  LOOP 

^COMMENTS: 

$ CHANGE  CONTROL: 

ORIGINATED:  24  MARCH  1987,  M. 


H.  CHOI,  DBMA 


(*  END  XINCLUDE  PSRABNDS 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 


**********************************************) 
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(*  BEGIN  %INCLUDE  PSRADB  **********************************************) 


PROCEDURE  PSRADB  (  VAR  PSRDATA 

CONST  RUNTIME 
CONST  ENTRY 
CONST  PS_ORDER 
SUBPROGRAM; 


TEXT; 

P_RUN_TIME ; 
INTEGEIR; 
T_PS_ORDER  ) ; 


^FUNCTION: 

WRITE  THE  BASIC  RECORD  OF  AN  ENTITY  TO  A  PHYSICAL  SCHEMA 
REPORT  FILE 


^DESCRIPTION  OF  ARGUMENTS: 


DESCRIPTION 


PSRDATA 
RUNTIME 
ENTRY 
PS  ORDER 


PHYSICAL  SCHEMA  REPORT  SEQUENTIAL  FILE*) 
CONTAINS  THE  ENTITY  DEFINITION  *) 
ENTRY  ORDER  IN  THE  DEFINITION  *) 
LIST  OF  ATTRIBUTES  IN  PHYSICAL  ORDER  *) 


(*  ^COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  WRITE  THE  BASIC  ATTRIBUTES  (  INTEGER,  REAL,  STRING,  LOGICAL)*) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  ORIGINATED:  09  MARCH  1987,  M.  H.  CHOI,  DBMA  *) 

(*  *) 

(*  END  XINCLUDE  PSRADB  ************************************************) 
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(*  BEGIN  %INCLUDE  PSRARRAY  ********************************************) 


(* 

PROCEDURE  PSRARRAY  (  VAR  PSRDATA  :  TEXT; 

CONST  RUNTIME  :  P_RUN_TIME; 

CONST  ENTRY  :  INTEGER; 

VAR  CL_HEADING_FLAG  :  BOOLEAN; 

VAR  ENUM_HEADING_FLAG  :  BOOLEAN; 

CONST  PS_ORDER  :  T_PS_ORDER  ); 

SUBPROGRAM; 

(* 

(*  $ FUNCTION: 

(*  WRITE  THE  ARRAY  ATTRIBUTE  OF  AN  ENTITY  TO  A  SEQUENTIAL 


*) 


*) 

*) 

FILE  *) 


(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  PSRDATA  0  PHYSICAL  SCHEMA  REPORT  TEXT  FILE  *) 

(*  RUNTIME  I  CONTAINS  THE  ENTITY  DEFINITION  *) 

(*  ENTRY  I  ENTRY  ORDER  IN  THE  DEFINITION  *) 

(*  CL_HEADING_FLAG  I  FLAG  TO  DETERMINE  WHETHER  THE  HEADING  *) 

(*  HAS  BEEN  WRITTEN  *) 

(*  PS_ORDER  I  LIST  OF  ATTRIBUTES  IN  PHYSICAL  ORDER  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  OBTAIN  THE  NUMBER  OF  DIMENSIONS  *) 

(*  OBTAIN  THE  STARTING  POSITION  OF  ARRAY  TABLE  *) 

(*  CASE  DATA  TYPE  OF  *) 

(*  IN-ADB  :  WRITE  BASIC  DEFINITION  *) 

(*  PSRABNDS  (  EXTERNAL  SUBPROGRAM  TO  WRITE  LOW-BOUND*) 

(*  AND  UPPER-BOUND  )  *) 

(*  IN-CL  :  WRITE  BASIC  DEFINITION  *) 

(*  PSRCL  (  EXTERNAL  SUBPROGRAM  FOR  CONSTITUENT  LIST)*) 

(*  PSRABNDS  (  EXTERNAL  SUBPROGRAM  TO  WRITE  LOW-BOUND*) 

(*  AND  UPPER-BOUND  )  *) 

(*  END  CASE  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 
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(*  ^CHANGE  CONTROL: 

(*  ORIGINATED:  09 -MARCH  1987,  M.  H.  CHOI,  DBMA  l] 

(*  END  %ma,UDE  PSRARRAY 
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(*  BEGIN  %INCLUDE  PSRCL  ***********************************************) 

(*  *) 
PROCEDURE  PSRCL  (  VAR  PSRDATA  :  TEXT; 

CONST  RUNTIME  :  P_RUN_TIME; 

CONST  ENTRY  :  INTEGER; 

VAR  CL_HEADING_FLAG  :  BOOLEAN; 

CONST  NO_OF_DIMEN  :  INTEGER; 

CONST  STARTING_POSITION  :  INTEGER; 

VAR  ARRAY_POINTER  :  T_VARIANT_POINTER  ); 
SUBPROGRAM; 


(*  *) 

(*  $ FUNCTION:  *) 

(*  WRITE  THE  CONSTITUENT  REFERENCES  OF  AN  ENTITY  TO  A  *) 

(*  SEQUENTIAL  FILE  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  PSRDATA  0  PHYSICAL  SCHEMA  REPORT  TEXT  FILE  *) 

(*  RUNTIME  I  CONTAINS  THE  ENTITY  DEFINITION  *) 


(*  ENTRY  I  ENTRY  ORDER  IN  THE  DEFINITION  *) 


(*  CL_HEADING_FLAG  I  FLAG  TO  DETERMINE  WHETHER  THE  HEADING  *) 


(*  HAS  BEEN  WRITTEN  *) 
(*  NO_OF_DIMEN  I  NUMBER  OF  ARRAY  DIMENSIONS  *) 
(*  STARTING_ARRAY_PO  I  STARTING  POSITION  IN  THE  ARRAY  TABLE  *) 
(*  ARRAYJPOINTER  I  POINTER  TO  ARRAY  TABLE  *) 
(*  *) 
(*  ^COMMONS:  *) 
(*  *) 
(*  ^ENVIRONMENT:  *) 
(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 
(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 
(*  ^EXECUTION  PROCEDURE:  *) 

(*  CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 
(*  *) 
(*  ^PROCESSING  DESCRIPTION:  *) 
(*  IF  NOT  ARRAY  ATTRIBUTE  THEN  *) 
(*  WRITE  BASIC  DEFINITION  *) 
(*  END  IF  *) 
(*  OBTAIN  THE  NUMBER  OF  ELIGIBLE  KINDS  *) 
(*  OBTAIN  STARTING  POSITION  OF  CONSTITUENT  LIST  TABLE  *) 
(*  LOOP  THROUGH  THE  NUMBER  OF  ELIGIBLE  KINDS  *) 
(*  WRITE  ELIGIBLE  KIND  IN  THE  CONSTITUENT  LIST  TABLE  *) 
(*  END  LOOP  *) 
(*  *) 
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(*  $ COMMENTS : 

(* 

(*  ^CHANGE  CONTROL: 
(*  ORIGINATED: 

(* 

(*  END  %INCLUDE  PSRCL 


*) 

*) 

09  MARCH  1987,  M.  H.  CHOI,  DBMA  *) 

******************************JkjkjkjiJkjkjtlkjkjk^jkjk^ikjk*) 
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(*  BEGIN  %INCLUDE  PSRENUM 
(* 

PROCEDURE  PSRENUM  ( 


(* 

(* 

(* 

(* 


********************************************* ) 

*) 

TEXT; 

P_RUN_TIME ; 

INTEGER; 

T_PS_ORDER ; 

BOOLEAN; 

INTEGER; 

INTEGER  ); 


VAR  PSRDATA 
CONST  RUNTIME 
CONST  ENTRY 
CONST  PS_ORDER 
VAR  ENUM_HEADING_FLAG 
CONST  ENUM_TABLE_INDEX 
CONST  NO_OF_VALUES 
SUBPROGRAM; 


^FUNCTION: 

WRITE  THE  ENUMERATION  ATTRIBUTE  OF  AN  ENTITY  TO  A 
SEQUENTIAL  FILE 


*) 

*) 

*) 

*) 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 


*) 

^DESCRIPTION  OF  ARGUMENTS:  *) 

NAME  I/O  DESCRIPTION  *) 

PSRDATA  0  PHYSICAL  SCHEMA  REPORT  SEQUENTIAL  FILE*) 

RUNTIME  I  CONTAINS  THE  ENTITY  DEFINITION  *) 

ENTRY  I  ENTRY  ORDER  IN  THE  DEFINITION  *) 

PS_ORDER  I  LIST  OF  ATTRIBUTES  IN  PHYSICAL  ORDER  *) 

ENUM_HEADING_FLAG  I  FLAG  TO  DETERMINE  WHETHER  THE  HEADING  *) 

HAS  BEEN  WRITTEN  *) 

*) 

$ COMMONS :  *) 

*) 

^ENVIRONMENT :  *) 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

^EXECUTION  PROCEDURE:  *) 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

^PROCESSING  DESCRIPTION:  *) 

WRITE  BASIC  DEFINITION  *) 

OBTAIN  THE  NUMBER  OF  ENUMERATION  VALUES  *) 

OBTAIN  THE  STARTING  POSITION  OF  ENUMERATION  VALUE  TABLE  *) 

LOOP  THROUGH  THE  NUMBER  OF  ENUMERATION  VALUES  *) 

WRITE  THE  ENUMERATION  VALUE  FROM  THE  TABLE  *) 

END  LOOP  *) 

$ COMMENTS :  *) 

$ CHANGE  CONTROL:  *) 

ORIGINATED:  09  MARCH  1987,  M.  H.  CHOI,  DBMA  *) 


*) 

END  XINCLUDE  PSRENUM  ***********************************************) 
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(*  BEGIN  %INCLUDE  PSREPORT  ********************************************) 
(*  *) 
PROCEDURE  PSREPORT  (  VAR  SUBSCHEMAJCEY  :  ENT KEY; 


VAR  IRC  :  RET_REC  ); 

SUBPROGRAM; 


(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

FILE  PHYSICAL  SCHEMA  REPEORT  TO  SEQUENTIAL  FILE 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME  I/O  DESCRIPTION 

*) 

(* 

n 

ii 

ii 

ii 

ii 

n 

ii 

n 

ii 

ii 

it 

ii 

ii 

n 

n 

ii 

ii 

ii 

*) 

(* 

SUBSCHEMAJKEY  I 

*) 

(* 

IRC  0 

*) 

(* 

*) 

(* 

^COMMONS : 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

*) 

(* 

$ COMMENTS : 

*) 

(* 

*) 

(* 

^CHANGE  CONTROL: 

*) 

<* 

ORIGINATED:  09  MARCH  1987,  M.  H.  CHOI,  DBMA 

*) 

(* 

*) 

(*  END  %INCLUDE  PSREPORT  **********************************************) 
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(*  BEGIN  %INCLUDE  PSRHEAD  *********************************************) 
(* 


PROCEDURE  PSRHEAD  (  VAR  PSRDATA 

CONST  RUNTIME 
CONST  PAGE_NO 
SUBPROGRAM; 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

c* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

<* 

(* 


TEXT; 

P_RUN_TIME ; 
INTEGER  ) ; 


$ FUNCTION: 

WRITE  THE  PHYSICAL  SCHEMA  REPORT  HEADING 
^DESCRIPTION  OF  ARGUMENTS: 


NAME 

PSRDATA 
RUNTIME 
PAGE  NO 


0 

I 

I 


*) 
*) 
*) 
*) 
*) 
*) 

===========  *) 

PHYSICAL  SCHEMA  REPORT  SEQUENTIAL  FILE*) 


I/O  DESCRIPTION 


CONTAINS  THE  ENTITY  DEFINITION 
NUMBER  OF  PAGE 


$ COMMONS : 


^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 

^PROCESSING  DESCRIPTION: 

WRITE  THE  HEADING 

^COMMENTS : 

$ CHANGE  CONTROL: 

ORIGINATED:  09  MARCH  1987,  M.  H.  CHOI,  DBMA 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 


(*  END  XINCLUDE  PSRHEAD  ***********************************************) 
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(*  BEGIN  ^INCLUDE  PSRINDEX 
(* 

PROCEDURE  PSRINDEX  (  VAR 

CONST 

CONST 

CONST 


********************************************) 


PSRDATA 
PAGE_NO 
ENTITY_INDEX 
LIST  OF_ENTITIES 


TEXT; 

INTEGER; 
T_ENTITY_INDEX 
LISTKEY  ); 


*) 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

<* 

(* 


SUBPROGRAM; 

*) 

$ FUNCTION:  *) 

WRITE  THE  TABLE  OF  CONTENTS  FOR  THE  PHYSICAL  SCHEMA  REPORT  *) 

*) 

^DESCRIPTION  OF  ARGUMENTS:  *) 

NAME  .  I/O  DESCRIPTION  *) 

PSRDATA  0  PHYSICAL  SCHEMA  REPORT  TEXT  FILE  *) 

PAGE_NO  I  PAGE  NUMBER  *) 

ENTITY_INDEX  I  ENTITY  NAME  AND  THE  KIND  NUMBER  *) 

LIST_OF_ENTITIES  I  LIST  OF  ENTITY  KEYS  TO  SORT  LATER  *) 

BY  THE  ENTITY  NAME  *) 

*) 

$ COMMONS:  *) 

*) 

^ENVIRONMENT:  *) 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

*) 

^EXECUTION  PROCEDURE:  *) 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

*) 

^PROCESSING  DESCRIPTION:  *) 

WRITE  THE  TABLE  OF  CONTENTS  IN  ORDER  OF  ENTITY  KIND  *) 

WRITE  THE  TABLE  OF  CONTENTS  IN  ORDER  OF  ENTITY  NAME  *) 

*) 

^COMMENTS:  *) 

*) 

^CHANGE  CONTROL:  *) 

ORIGINATED:  09  MARCH  1987,  M.  H.  CHOI,  DBMA  *) 

*) 


END  %INCLUDE  PSRINDEX  **********************************************) 
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(*  BEGIN  %INCLUDE  PSRNAME  *********************************************) 
r*  “  *) 


PROCEDURE  PSRNAME  (  VAR  PSRDATA 

CONST  RUNTIME 
CONST  ENTRY 


VAR 

VAR 

VAR 

SUBPROGRAM; 


GLOBALJTLAG 
INHERITED_FLAG 
LOCAL  FLAG 


TEXT; 

P_RUN_TIME; 
INTEGER; 
BOOLEAN; 
BOOLEAN; 
BOOLEAN  ); 


^FUNCTION: 

INDICATE  WHETHER  THE  ATTRIBUTE  IS  GLOBAL,  INHERITED,  OR 
LOCAL  FOR  THE  PHYSICAL  SCHEMA  REPORT. 


^DESCRIPTION  OF  ARGUMENTS: 


DESCRIPTION 


PSRDATA 
RUNTIME 
ENTRY 
PS  ORDER 


PHYSICAL  SCHEMA  REPORT  SEQUENTIAL  FILE*) 
CONTAINS  THE  ENTITY  DEFINITION  *) 
ENTRY  ORDER  IN  THE  DEFINITION  *) 
LIST  OF  ATTRIBUTES  IN  PHYSICAL  ORDER  *) 


$ COMMONS : 

^ENVIRONMENT : 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM 


(*  ^PROCESSING  DESCRIPTION:  *) 

(*  WRITE  THE  BASIC  ATTRIBUTES  (  INTEGER,  REAL,  STRING,  LOGICAL)*) 

<*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  ORIGINATED:  26  JANUARY  1988,  M.  H.  CHOI,  DBMA  *) 

(*  *) 

(*  END  %INCLUDE  PSRNAME  ***********************************************) 
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(*  BEGIN  %INCLUDE  PSRSTC  **********************************************) 
(*  *) 
PROCEDURE  PSRSTC  (  VAR  PSRDATA  :  TEXT; 

CONST  RUNTIME  :  P_RUN_TIME; 

CONST  PS_ORDER  :  T_PS_ORDER; 

VAR  ENTRY  :  INTEGER; 

VAR  CL_HEADING_FLAG  :  BOOLEAN; 

VAR  ENUM_HEADING_FLAG  :  BOOLEAN; 

VAR  LIST_OF_STRUCTURE :  T_ENUME RATION; 

VAR  S_COUNT  :  INTEGER  ); 

SUBPROGRAM; 


(*  *) 

(*  $ FUNCTION:  *) 

(*  WRITE  THE  STRUCTURE  ATTRIBUTE  OF  AN  ENTITY  TO  A  PHYSICAL  *) 

(*  SCHEMA  REPORT  FILE  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  PSRDATA  0  PHYSICAL  SCHEMA  REPORT  SEQUENTIAL  FILE*) 

(*  RUNTIME  I  CONTAINS  THE  ENTITY  DEFINITION  *) 

(*  ENTRY  I  ENTRY  ORDER  IN  THE  DEFINITION  *) 

(*  PS_ORDER  I  LIST  OF  ATTRIBUTES  IN  PHYSICAL  ORDER  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4331  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  WRITE  THE  STRUCTURE  ATTRIBUTE  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  ORIGINATED:  15  JANUARY  1988,  M.  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  %INCLUDE  PSRSTC  ************************************************) 
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(*  BEGIN 
(* 

PROCEDURE 


%INCLUDE  PSTRGF  **********************************************) 
. . .  *  *) 


(* 

(* 

(* 

(* 

<* 


(* 

(* 

(* 

<* 

(* 

(* 

(* 

<* 

<* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 


PSTRGF  (  VAR 
VAR 
VAR 
VAR 
VAR 
VAR 
VAR 
VAR 

SUBPROGRAM; 


ENTITY 

ENUM 

ENUM_INDEX 

ARRAY_LIST 

ARRAY_INDEX 

CL_INDEX 

CL_LIST 

IRC 


P_SCHEMA; 
T_ENUM_COMPACTOR; 
T_ENUM_INX_COMPACTOR ; 
T_ARRAY_LI ST_COMPACTOR ; 
T_ARRAY_INX_COMPACTOR ; 
T_CL_INX_COMPACTOR ; 
T_CL_KINDS_COMPACTOR ; 
RET_REC  ); 


^FUNCTION: 

TRANSLATE  THE  GLOBAL  FIELDS  INTO 
FOR  THE  PHYSICAL  SCHEMA  REPORT. 


A  RUN-TIME  SUBSCHEMA 


=  0  SUCCESS 


$ COMMONS : 


^ENVIRONMENT : 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

RUN-TIME  SUBSCHEMA 

CALLED  FROM  THE  NAME/VALUE  INTERFACE 

^PROCESSING  DESCRIPTION: 

INITIALIZE  TABLE  INDEXES 

MAKE  A  LIST  OF  GLOBAL  KINDS 

LOOP  THROUGH  A  LIST  OF  GLOBAL  KINDS 

TRANSLATE  GLOBAL  FIELD  INTO  A  RUN-TIME  SUBSCHEMA 


*) 

*) 

*) 

*) 

*) 


<* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME 

I/O 

DESCRIPTION 

*) 

(* 

==== 

=== 

u 

ii 

ii 

ii 

ii 

ii 

ii 

ii 

ii 

n 

ii 

*) 

(* 

(* 

ENTITY 

0 

RUN-TIME  SUBSCHEMA  WHICH  CONTAINS  THE 
ENTITY  DEFINITION 

*) 

*) 

(* 

ENUM 

0 

ENUMERATION  VALUES 

*) 

(* 

ENUM_INDEX 

0 

ENUMERATION  INDEX  TABLE 

*) 

(* 

ARRAY_LIST 

0 

LOWER  BOUND  AND  ARRAY  SIZE 

*) 

<* 

ARRAY_INDEX 

0 

ARRAY  INDEX  TABLE 

*) 

(* 

CL_INDEX 

0 

CONSTITUENT  INDEX  TABLE 

*) 

<* 

CL_LIST 

0 

CONSTITUENT  KINDS 

*) 

(* 

IRC 

0 

RETURN  CODE 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 
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(*  $ COMMENTS:  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 
(*  ORIGINATED:  25  JANUARY  1988,  M.  H-  CHOI,  DBMA  *) 
(*  *) 


(*  END  ^INCLUDE  PSTRGF  ************************************************) 
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(*  BEGIN  /^INCLUDE  PSTRSM  **********************************************) 

(*  *) 
PROCEDURE  PSTRSM  (  CONST  ENTITY_KEY  :  LISTKEY; 

VAR  NAME_TYPE  :  CHAR; 

VAR  ENTITY  :  P_SCHEMA; 

VAR  ENUM  :  T_ENUM_COMPACTOR ; 

VAR  ENUM_INDEX  :  T_ENUM_INX_COMPACTOR; 

VAR  ARRAY_LIST  :  T_ARRAY_LIST_COMPACTOR ; 

VAR  ARRAY_INDEX  :  T_ARRAY_INX_COMPACTOR ; 

VAR  CL_INDEX  :  T_CL_INX_COMPACTOR; 

VAR  CL_LIST  :  T_CL_KINDS_COMPACTOR; 

VAR  IRC  :  RET_REC  ); 

SUBPROGRAM; 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


$ FUNCTION:  *) 

TRANSLATE  A  SCHEMA  MODEL  ENTRY  INTO  A  RUN-TIME  SUBSCHEMA  *) 

ENTITY,  ENUMERATION  TABLE  AND  ARRAY  INFO  TABLE  FOR  *) 

THE  PHYSICAL  SCHEMA  REPORT.  *) 

^DESCRIPTION  OF  ARGUMENTS :  *) 

NAME  I/O  DESCRIPTION  *) 

ARRAY_INDEX  0  RUN-TIME  SUBSCHEMA  ARRAY  TABLE  INDEX  *) 

INFORMATION.  *) 

ARRAY JLIST  0  RUN-TIME  SUBSCHEMA  ARRAY  TABLE  *) 

AND  COMPACTION  INFORMATION.  *) 

ENUM  0  RUN-TIME  SUBSCHEMA  ENUMERATION  TABLE  *) 

AND  COMPACTION  INFORMATION.  *) 

ENUM_INDEX  0  RUN-TIME  SUBSCHEMA  ENUMERATION  TABLE  *) 

INDEX  INFORMATION.  *) 

ENTITY  0  RUN-TIME  SUBSCHEMA  ENTITY  DEFINITION.*) 

ENTITYJOBY  I  KEY  FROM  SCHEMA  MODEL  WHICH  THE  *) 

TRANSLATION  WILL  BE  PERFORMED.  *) 

IRC  0  RETURN  CODE  *) 

=  0  SUCCESS  *) 

>  0  CRITICAL  ERROR:  *) 

*) 

$ COMMONS:  *) 

*) 

^ENVIRONMENT:  *) 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 


^EXECUTION  PROCEDURE:  *) 

NAME/VALUE  INTERFACE  *) 

CALLED  FROM  THE  NAME/VALUE  INTERFACE  *) 

*) 
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3 


(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


^PROCESSING  DESCRIPTION:  *) 

OBTAIN  ENTITY  NAME  AND  KIND  FROM  SCHEMA  MODEL  *) 

STORE  ENTITY  NAME  AND  KIND  INTO  RUN-TIME  SUBSCHEMA  *) 

LOOP  THROUGH  SCHEMA  MODEL  ENTRIES  *) 

OBTAIN  ATTRIBUTE  ENTRY  FROM  SCHEMA  MODEL  *) 

CASE  DATA  TYPE  OF  *) 

INTEGER,  REAL,  STRING,  LOGICAL  *) 


:  APPLICATION_DATA_BLOCK_ATTRIBUTE,  PROCEDURE  (1)  *) 
POINTER  :  CONSTITUENT_LIST_ATTRIBUTE,  PROCEDURE  (2)  *) 
ARRAY  :  ARRAY_ATTRIBUTE ,  PROCEDURE  (3)  *) 

DEFINEDJTYPE  :  DEFINED_TYPE_ATTRIBUTE,  PROCEDURE  (4)  *) 
OTHERWISE  :  ERROR  MESSAGE  =  'UNKNOWN  ATTRIBUTE  TYPE'  *) 
ENDCASE  *) 

ENDLOOP  *) 


(*  PROCEDURE  (1)  :  APPLICATION_DATA_BLOCK_ATTRIBUTE  *) 

(*  STORE  ATTRIBUTE  DEFINITION  FOR  TYPE  IN  SCHEMA  MODEL  ENTRY  *) 

(*  *) 

(*  PROCEDURE  (2)  :  CONSTITUENT_LIST_ATTRIBUTE  *) 

(*  OBTAIN  CONSTITUENT  LIST  POSITION  FROM  SCHEMA  MODEL  *) 

(*  STORE  ATTRIBUTE  DEFINITION  FOR  TYPE  IN  SCHEMA  MODEL  ENTRY  *) 

(*  *) 

(*  PROCEDURE  (3)  :  ARRAY_ATTRIBUTE  *) 

(*  DETERMINE  THE  NUMBER  OF  ARRAY  DIMENSIONS  *) 

(*  STORE  ARRAY  INFORMATION  INTO  RUN-TIME  SUBSCHEMA  *) 

(*  STORE  TABLE  INDEX  POSITION  FOR  ARRAY  LIST  TABLE  AND  THE  *) 

(*  NUMBER  OF  DIMENSIONS  INTO  ARRAY  INDEX  TABLE  *) 

(*  CALCULATE  TOTAL  SIZE  OF  THE  ARRAY  AND  STORE  INTO  ARRAY  *) 

(*  INDEX  TABLE  *) 

(*  FOR  THE  NUMBER  OF  ARRAY  DIMENSIONS  *) 

(*  CALCULATE  THE  SIZE  OF  EACH  ARRAY  *) 

(*  STORE  SIZE  AND  LOW-BOUND  INTO  ARRAY  LIST  TABLE  *) 

(*  END  LOOP  *) 

(*  *) 

(*  PROCEDURE  (4)  :  DEFINED_TYPE_ATTRIBUTE  *) 

(*  OBTAIN  DATA  TYPE  FOR  DEFINED  TYPE  ATTRIBUTE  IN  SCHEMA  MODEL  *) 

(*  CASE  DATATYPE  OF  *) 

(*  INTEGER,  REAL,  STRING,  LOGICAL  *) 

(*  *  :  APPLICATION_DATA_BLOCK_ATTRIBUTE,  PROCEDURE  (1)  *) 

(*  ENUMERATION  :  ENUMERATION_ATTRIBUTE ,  PROCEDURE  (5)  *) 

(*  POINTER  :  CONSTITUENT_LIST_ATTRIBUTE,  PROCEDURE  (2)  *) 

(*  ARRAY  :  ARRAY_ATTRIBUTE ,  PROCEDURE  (3)  *) 

(*  OTHERWISE  :  ERROR  MESSAGE  =  'UNKNOWN  ATTRIBUTE  TYPE'  *) 

(*  ENDCASE  *) 

(*  *) 
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(*  PROCEDURE  (5)  :  ENUMERATION_ATTRIBUTE  *) 

(*  STORE  ATTRIBUTE  DEFINITION  FOR  ENUMERATION  TYPE  *) 

(*  OBTAIN  NUMBER  OF  ENUMERATION  VALUES  FROM  SCHEMA  MODEL  *) 

(*  STORE  NUMBER  OF  ENUMERATION  VALUE  IN  ENUMERATION  INDEX  TABLE*) 

(*  STORE  ENUMERATION  VALUE  TABLE  INDEX  POSITION  IN  ENUMERATION  *) 

(*  INDEX  TABLE  *) 

(*  LOOP  THROUGH  ENUMERATION  VALUES  *) 

(*  OBTAIN  ENUMERATION  VALUE  FROM  SCHEMA  MODEL  *) 

(*  STORE  ENUMERATION  VALUE  IN  ENUMERATION  VALUE  TABLE  *) 

(*  END  LOOP  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION)  *) 

(*  ORIGINATED:  25  JANUARY  1988,  M.  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  %INCLUDE  PSTRSM  ************************************************) 
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(*  BEGIN  %INCLUDE  PSTRST  **********************************************) 
(*  *) 


PROCEDURE  PSTRST  (  CONST 

SUBTYPEJCEY 

ENTKEY; 

VAR 

ENTITY 

P_SCHEMA; 

VAR 

ENUM 

T_ENUM_COMPACTOR ; 

VAR 

ENUM_INDEX 

T_ENUM_INX_COMPACTOR ; 

VAR 

ARRAY JjIST 

T_ARRAY_LI ST_COMPACTOR ; 

VAR 

ARRAY_INDEX 

T_ARRAY_INX_COMPACTOR ; 

VAR 

CL_INDEX 

T_CL_INX_COMPACTOR ; 

VAR 

CL_LIST 

T_CL_KINDS_COMPACTOR ; 

VAR 

IRC 

RET_REC  ); 

SUBPROGRAM; 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

TRANSLATE  SUPER  TYPE  INTO  A  RUN- 

-TIME  SUBSCHEMA  FOR 

*) 

(* 

THE  PHYSICAL  SCHEMA  REPORT. 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME 

I/O  DESCRIPTION 

*) 
*  \ 

(* 

SUBTYPEJCEY 

I  KEY  FROM  SCHEMA  MODEL  WHICH  THE 

X) 

*) 

(* 

TRANSLATION  WILL  BE  PERFORMED. 

*) 

(* 

>  0  CRITICAL  ERROR: 

*) 

(* 

ENTITY 

0  RUN-TIME  SUBSCHEMA  WHICH  CONTAINS  THE 

*) 

(* 

ENTITY  DEFINITION 

*) 

(* 

ENUM 

0  ENUMERATION  VALUES 

*) 

(* 

ENUM_INDEX 

0  ENUMERATION 

INDEX  TABLE 

*) 

(* 

ARRAY_LIST 

0  LOWER  BOUND 

AND  ARRAY  SIZE 

*) 

(* 

ARRAY_INDEX 

0  ARRAY  INDEX 

TABLE 

*) 

(* 

CL_INDEX 

0  CONSTITUENT 

INDEX  TABLE 

*) 

(* 

CL_LIST 

0  CONSTITUENT 

KINDS 

*) 

(* 

IRC 

0  RETURN  CODE 

*) 

(* 

=  0  SUCCESi 

5 

*) 

(* 

*) 

(* 

$ COMMONS : 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM 

PASCAL  (SEGMENT  SUBPROGRAM) 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*> 

(* 

RUN-TIME  SUBSCHEMA 

*) 

(* 

CALLED  FROM  THE  NAME/VALUE  INTERFACE 

*> 

<* 

*) 
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(* 

(* 

C* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


^PROCESSING  DESCRIPTION: 

MAKE  A  LIST  OF  SUPER  TYPE 
LOOP  THROUGH  A  LIST  OF  SUPER  TYPE 

TRANSLATE  SUPER  TYPE  INTO  A  RUN-TIME  SUBSCHEMA 

$ COMMENTS: 

$ CHANGE  CONTROL: 

ORIGINATED:  25  JANUARY  1988,  M.  H.  CHOI,  DBMA 


*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 


(*  END  ^INCLUDE  PSTRST 
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(*  BEGIN  %INCLUDE  PSTRSTC  *********************************************) 


PROCEDURE  PSTRSTC  (  CONST  ENTITYJCEY 

CONST  NAME_TYPE 
VAR  S_OFFSET 
VAR  ENTITY 
VAR  ENUM 
VAR  ENUM_INDEX 
VAR  ARRAY_LIST 
VAR  ARRAY_INDEX 
VAR  CL_INDEX 
VAR  CL_LIST 
VAR  IRC 
SUBPROGRAM; 


LISTKEY; 

CHAR; 

INTEGER; 

P_SCHEMA; 
T_ENUM_COMPACTOR; 
T_ENUM_I NX_C OMPA CTOR ; 
T_ARRAY_LIST_COMPACTOR ; 
T_ARRAY_INX_COMPACTOR ; 
T_CL_INX_COMPACTOR ; 
T_CL_KINDS_COMPACTOR ; 
RET_REC  ) ; 


^FUNCTION: 

TRANSLATE  A  STRUCTURE  ATTRIBUTE  INTO  A  RUN-TIME  SUBSCHEMA 
ENTITY,  ENUMERATION  TABLE  AND  ARRAY  INFO  TABLE  FOR 
THE  PHYSICAL  SCHEMA  REPORT. 


^DESCRIPTION  OF  ARGUMENTS: 


DESCRIPTION 


ARRAY_INDEX 

ARRAY_LIST 

ENUM 

ENUM_INDEX 

ENTITY 
ENTITY  KEY 


RUN-TIME  SUBSCHEMA  ARRAY  TABLE  INDEX  *) 
INFORMATION.  *) 
RUN-TIME  SUBSCHEMA  ARRAY  TABLE  *) 
AND  COMPACTION  INFORMATION.  *) 
RUN-TIME  SUBSCHEMA  ENUMERATION  TABLE  *) 
AND  COMPACTION  INFORMATION.  *) 
RUN-TIME  SUBSCHEMA  ENUMERATION  TABLE  *) 
INDEX  INFORMATION.  *) 
RUN-TIME  SUBSCHEMA  ENTITY  DEFINITION.*) 
KEY  FROM  SCHEMA  MODEL  WHICH  THE  *) 
TRANSLATION  WILL  BE  PERFORMED.  *) 
RETURN  CODE  *) 
=  0  SUCCESS  *) 
>  0  CRITICAL  ERROR:  *) 


$ COMMONS: 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 
HARDWARE  SYSTEM:  IBM  360/370/4341/4381 


^EXECUTION  PROCEDURE: 

NAME/VALUE  INTERFACE 

CALLED  FROM  THE  NAME/VALUE  INTERFACE 
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(*  ^PROCESSING  DESCRIPTION:  *) 
(*  OBTAIN  ENTITY  NAME  AND  KIND  FROM  SCHEMA  MODEL  *) 
(*  STORE  ENTITY  NAME  AND  KIND  INTO  RUN-TIME  SUBSCHEMA  *) 
(*  LOOP  THROUGH  SCHEMA  MODEL  ENTRIES  *) 
(*  OBTAIN  ATTRIBUTE  ENTRY  FROM  SCHEMA  MODEL  *) 
(*  CASE  DATA  TYPE  OF  *) 
(*  INTEGER,  REAL,  STRING,  LOGICAL  *) 


(*  :  APPLICATION_DATA_BLOCK_ATTRIBUTE,  PROCEDURE  (1)  *) 
(*  POINTER  :  CONSTITUENT_LIST_ATTRIBUTE ,  PROCEDURE  (2)  *) 
(*  ARRAY  :  ARRAY_ATTRIBUTE ,  PROCEDURE  (3)  *) 
(*  DEFINEDJTYPE  :  DEFINED_TYPE_ATTRIBUTE ,  PROCEDURE  (4)  *) 
(*  OTHERWISE  :  ERROR  MESSAGE  =  'UNKNOWN  ATTRIBUTE  TYPE'  *) 


(*  ENDCASE  *) 

(*  ENDLOOP  *) 

(*  PROCEDURE  (1)  :  APPLI CATION_DATA_BLOCK_ATTRI BUTE  *) 

(*  STORE  ATTRIBUTE  DEFINITION  FOR  TYPE  IN  SCHEMA  MODEL  ENTRY  *) 

(*  *) 

(*  PROCEDURE  (2)  :  CONSTITUENT_LIST_ATTRIBUTE  *) 

(*  OBTAIN  CONSTITUENT  LIST  POSITION  FROM  SCHEMA  MODEL  *) 

(*  STORE  ATTRIBUTE  DEFINITION  FOR  TYPE  IN  SCHEMA  MODEL  ENTRY  *) 

(*  *) 

(*  PROCEDURE  (3)  :  ARRAY_ATTRI BUTE  *) 

(*  DETERMINE  THE  NUMBER  OF  ARRAY  DIMENSIONS  *) 

(*  STORE  ARRAY  INFORMATION  INTO  RUN-TIME  SUBSCHEMA  *) 

(*  STORE  TABLE  INDEX  POSITION  FOR  ARRAY  LIST  TABLE  AND  THE  *) 

(*  NUMBER  OF  DIMENSIONS  INTO  ARRAY  INDEX  TABLE  *) 

(*  CALCULATE  TOTAL  SIZE  OF  THE  ARRAY  AND  STORE  INTO  ARRAY  *) 

(*  INDEX  TABLE  *) 

(*  FOR  THE  NUMBER  OF  ARRAY  DIMENSIONS  *) 

(*  CALCULATE  THE  SIZE  OF  EACH  ARRAY  *) 

(*  STORE  SIZE  AND  LOW-BOUND  INTO  ARRAY  LIST  TABLE  *) 

(*  END  LOOP  *) 

(*  *) 

(*  PROCEDURE  (4)  :  DEFINED_TYPE_ATTRIBUTE  *) 

(*  OBTAIN  DATA  TYPE  FOR  DEFINED  TYPE  ATTRIBUTE  IN  SCHEMA  MODEL  *) 

(*  CASE  DATATYPE  OF  *) 

(*  INTEGER,  REAL,  STRING,  LOGICAL  *) 


(*  :  APPLICATION_DATA_BLOCK_ATTRIBUTE,  PROCEDURE  (1)  *) 


(* 

ENUMERATION  :  ENUMERATION_ATTRIBUTE , 

PROCEDURE 

(5) 

*) 

(* 

POINTER  : 

CONSTITUENT_LIST_ATTRIBUTE, 

PROCEDURE 

(2) 

*) 

<* 

ARRAY  : 

ARRAY_ATTP.IBUTE , 

PROCEDURE 

(3) 

*) 

(* 

OTHERWISE 

:  ERROR  MESSAGE  =  'UNKNOWN  ATTRIBUTE  TYPE' 

*) 

(* 

ENDCASE 

*) 

(* 

*) 

(* 

PROCEDURE 

(5)  :  ENUMERATION_ATTRIBUTE 

*) 

(* 

STORE 

ATTRIBUTE 

DEFINITION  FOR  ENUMERATION  TYPE 

*) 
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(*  OBTAIN  NUMBER  OF  ENUMERATION  VALUES  FROM  SCHEMA  MODEL  *) 
(*  STORE  NUMBER  OF  ENUMERATION  VALUE  IN  ENUMERATION  INDEX  TABLE*) 
(*  STORE  ENUMERATION  VALUE  TABLE  INDEX  POSITION  IN  ENUMERATION  *) 
(*  INDEX  TABLE  *) 
(*  LOOP  THROUGH  ENUMERATION  VALUES  *) 
(*  OBTAIN  ENUMERATION  VALUE  FROM  SCHEMA  MODEL  *) 
(*  STORE  ENUMERATION  VALUE  IN  ENUMERATION  VALUE  TABLE  *) 
(*  END  LOOP  *) 
(*  *) 
(*  ^COMMENTS:  *) 
<*  *) 
(*  $ CHANGE  CONTROL:  *) 
(*  REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION)  *) 
(*  ORIGINATED:  25  JANUARY  1988,  M.  H.  CHOI,  DBMA  *) 
(*  *) 


(*  END  ^INCLUDE  PSTRSTC  ***********************************************) 
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(*  %INCLUDE  REARRAY  *) 

(**) 

PROCEDURE  REARRAY(VAR  MESS  :  MESSAGE; 

VAR  LBND  :  CHAR8; 

VAR  HBND  :  CHAR8 ; 

VAR  FTYPE  :  CHAR12; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  REVIEW  ARRAY  PANEL.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  LBND  I  THE  LOWER  BOUND  OF  THE  ARRAY  *) 

(*  HBND  I  THE  UPPER  BOUND  OF  THE  ARRAY  *) 

(*  FTYPE  I  THE  ARRAY  TYPE  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  .^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  REVIEW  ARRAY  PANEL  (REARRAY)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  *) 

(*  *) 
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(* 

$ COMMENTS : 

(* 

NONE 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

*) 

-*) 
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(*  %INCLUDE  RECLASS  *) 

(**) 

PROCEDURE  RECLASS (VAR  MESS 
VAR  NAME 
VAR  KNUM 
VAR  COMMENT 
VAR  CLAS 
VAR  ARRAY_SIZE 
VAR  MEMBER 
VAR  NEXT_OP 
VAR  RR 

SUBPROGRAM; 


MESSAGE; 

T_NAME; 

CHAR8 ; 

CHAR150; 

T_ARRAYTV; 

INTEGER; 

T_NAME; 

OPERATIONS; 

RET_REC) ; 


<**) 


(*- 

— 

-*) 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

THIS  FUNCTION: 

*) 

(* 

DISPLAYS  THE  REVIEW  CLASS  PANEL 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF 

ARGUMENTS : 

*) 

(* 

NAME 

I/O 

DESCRIPTION 

*) 

(* 

MESS 

I 

THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 

*) 

(* 

NAME 

I 

THE  CLASS  NAME 

*) 

(* 

KNUM 

I 

THE  CLASS  KIND  NUMBER 

*) 

<* 

CLAS 

I 

THE  ARRAY  OF  MEMBERS 

*) 

(* 

ARRAY_SIZE 

I 

THE  SIZE  OF  THE  ARRAY  OF  MEMBERS 

*) 

(* 

MEMBER 

0 

THE  MEMBER  SELECTED 

*) 

(* 

NEXT.  OP 

0 

ENUMERATED  TYPE  INDICATING  THE  NEXT 

*) 

(* 

OPERATION 

*) 

(* 

RR 

0 

INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 

*) 

(* 

IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 

*) 

(* 

*) 

(* 

$ COMMONS : 

*) 

(* 

NONE 

*) 

<* 

*) 

<* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE: 

IBM  PASCAL 

*) 

(* 

HARDWARE  SYSTEM: 

IBM  360/370/4341/4381 

*) 

(* 

DDNAMES  USED  WITH 

STANDARD  FILES: 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

SCHEMA  EXECUTIVE 

MENU  INTERFACE  ROUTINE 

*) 

(*  *) 


3-418 


Cl  PS560240032U 


April  1990 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

DISPLAY  THE  REVIEW 

CLASS  PANEL  (RECLASS)  BY  MAKING  ISPLNK 

*) 

(* 

CALLS.  THE  OPTION 

CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED 

*) 

(* 

TYPE. 

*) 

(* 

*) 

(* 

$ COMMENTS: 

*) 

(* 

NONE 

*) 

(* 

*> 

(* 

$ CHANGE  CONTROL: 

*) 

<* 

*) 
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(*  %INCLUDE  REDEFTYP  *) 

(**) 

PROCEDURE  REDEFTYP (VAR  MESS  :  MESSAGE; 

VAR  NAME  :  IDCHAR; 

VAR  FTYPE  :  CHAR12; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  DEFINED  TYPE  REVIEW  PANEL  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NAME  0  THE  NAME  OF  THE  DEFINED  TYPE  ENTERED  *) 

(*  FTYPE  0  TYPES  INTEGER, STRING, REAL. . .ETC.  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

<*  *) 

(*  .^PROCESSING  DESCRIPTION:  *) 

(*  '  DISPLAY  THE  REVIEW  DEFINED  TYPE  PANEL  (REDEFTYP)  BY  MAKING  *) 

(*  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  *) 

(*  ENUMERATED  TYPE.  *) 

(*  *) 

(*  $ COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 
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(*  %INCLUDE  REENTITY  *) 

(**) 

PROCEDURE  REENTITY (VAR  MESS  :  MESSAGE; 

VAR  NAME  :  T_NAME; 

VAR  KNUM  :  CHAR8; 

VAR  COMMENT  :  CHAR150; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  PROCEDURE  :  *) 

(*  DISPLAYS  THE  REVIEW  ENTITY  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NAME  I  THE  ENTITY  NAME  *) 

(*  KNUM  I  THE  ENTITY  KIND  NUMBER  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

<*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  REVIEW  ENTITY  PANEL  (REENTITY)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  *) 

(*  *) 
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(*  $ COMMENTS : 

(*  NONE 

(* 

(*  $ CHANGE  CONTROL: 
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(*  %INCLUDE  REENUM  *) 

(**) 

PROCEDURE  REENUM(VAR  MESS  :  MESSAGE; 

VAR  MEMBERS  :  T_ARRAYID; 

VAR  SIZE  :  INTEGER; 

VAR  NEXTJDP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

<* - *) 

(*  *) 

<*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  REVIEW  ENUMERATION  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  MEMBERS  I  THE  ARRAY  OF  MEMBERS  TO  DISPLAY  *) 

(*  SIZE  I  THE  SIZE  OF  THE  ARRAY  OF  NUMBERS  *) 

(*  NEXT.OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISLAY  THE  REVIEW  ENUMERATION  MENU  (REENUM)  BY  MAKING  *) 

(*  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  *) 

(*  ENUMERATED  TYPE.  *) 

(*  *> 

(*  $ COMMENTS :  *) 

(■'*  NONE  *) 

<*  *) 

(*'  $  CHANGE  CONTROL:  *) 
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(*  %INCLUDE  REFIELD  *) 

(**) 

PROCEDURE  REFIELD(VAR  MESS 

MESSAGE; 

VAR  NAME 

T_NAME; 

VAR  POS 

CHAR8; 

(*  VAR  PURP 

CHAR8;  *) 

VAR  REQD 

CHAR8; 

(*  VAR  DEPD 

CHAR12;  *) 

VAR  FTYPE 

CHAR12; 

VAR  FLDT 

CHAR9; 

VAR  NEXT.OP 

OPERATIONS 

VAR  RR 

RET_REC) ; 

SUBPROGRAM; 


<**) 

<* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  PROCEDURE  :  *) 

(*  DISPLAYS  THE  REVIEW  FIELD  PANEL  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NAME  I  THE  NAME  OF  THE  ARRAY  *) 

(*  PURP  I  THE  PURPOSE  OF  THE  ARRAY  *) 

(*  REQD  I  THE  REQUIREDNESS  OF  THE  ARRAY  *) 

(*  DEPD  I  THE  DEPENDENCE/ INDEPENDENCE  OF  THE  ARRAY  *) 

(*  FTYPE  I  THE  TYPE  OF  ELEMENT  STORED  IN  THE  ARRAY  *) 

(*  FLDT  I  THE  TYPE  OF  ARRAY  (GLOBAL,  STRUCTURE,  *) 

(*  ENTITY)  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

<*  *) 

<*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 
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(* 

(* 

(* 

C* 

C* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

DDNAMES  USED  WITH  STANDARD  FILES: 

NONE 


^EXECUTION  PROCEDURE: 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 


^PROCESSING  DESCRIPTION: 

DISPLAY  THE  REVIEW  FIELD  PANEL  (REFIELD)  BY  MAKING  ISPLNK 

CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED 

1  • 


$ COMMENTS : 
NONE 


$ CHANGE  CONTROL: 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  7.INCLUDE  REFIELD1  *) 

(**) 

PROCEDURE  REFIELD1(VAR  MESS 

VAR  FIELD_TYPE 
VAR  NAME 
VAR  KNUM 
VAR  MEMBERS 
VAR  SIZE 
VAR  FNAME 
VAR  NEXT_OP 
VAR  RR 

SUBPROGRAM; 

(**) 


MESSAGE; 

T_FIELDTYPE; 

T_NAME; 

CHAR8 ; 

T_ARRAYID; 

INTEGER; 

T_NAME; 

OPERATIONS; 

RET_REC) ; 


^FUNCTION: 

THIS  PROCEDURE  : 

DISPLAYS  THE  REVIEW  FIELD  A  MENU  OR  THE 
REVIEW  FIELD  B  MENU 

^DESCRIPTION  OF  ARGUMENTS: 

NAME  I/O  DESCRIPTION 


MESS 

FIELD  JTYPE 

NAME 

KNUM 

MEMBERS 

SIZE 

FNAME 

NEXT  OP 


THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 

THE  TYPE  OF  FIELD  TO  BE  REVIEWED 

THE  ENTITY  NAME 

THE  ENTITY  KIND  NUMBER 

THE  ARRAY  OF  MEMBERS  TO  SELECT  FROM 

THE  SIZE  OF  THE  ARRAY  OF  MEMBERS 

THE  MEMBER  SELECTED 

ENUMERATED  TYPE  INDICATING  THE  NEXT 

OPERATION 

INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 
IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 


$ COMMONS: 

NONE 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

DDNAMES  USED  WITH  STANDARD  FILES: 

NONE 


^EXECUTION  PROCEDURE: 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  ^PROCESSING  DESCRIPTION:  *) 
(*  DISPLAY  THE  REVIEW  ENTITY  PANEL  (REFIELD1)  BY  MAKING  ISPLNK  *) 
(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 
(*  TYPE.  *) 
(*  *) 
(*  $ COMMENTS :  *) 
(*  NONE  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 
(*  *) 
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(*  %INCLUDE  REFIELD2  *) 

(**) 

PROCEDURE  REFIELD2(VAR  MESS 

MESSAGE; 

VAR  NAME 

T_NAME; 

VAR  POS 

CHAR8 ; 

(*  VAR  PURP 

CHAR8 ;  *) 

VAR  REQD 

CHAR8; 

(*  VAR  DEPD 

CHAR12;  *) 

VAR  COM 

CHAR50; 

VAR  FTYPE 

CHAR12; 

VAR  FLDT 

CHAR9 ; 

VAR  NEXT_OP 

OPERATIONS 

VAR  RR 

RET_REC) ; 

SUBPROGRAM; 

(**) 


<*-- 

-*) 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

THIS  PROCEDURE  : 

*) 

<* 

DISPLAYS  THE  REVIEW  FIELD  PANEL 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME 

I/O 

DESCRIPTION 

*) 
*  ^ 

V 

(* 

MESS 

I 

THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 

*) 

(* 

NAME 

I 

THE  NAME  OF  THE  ARRAY 

*) 

<* 

POS 

I 

THE  POSITION  OF  THE  FIELD  IN  THE  ADB 

*) 

(* 

PURP 

I 

THE  PURPOSE  OF  THE  ARRAY 

*) 

(* 

REQD 

I 

THE  REQUIREDNESS  OF  THE  ARRAY 

*) 

(* 

DEPD 

I 

THE  DEPENDENCE/INDEPENDENCE  OF  THE  ARRAY 

*) 

(* 

FTYPE 

I 

THE  TYPE  OF  ELEMENT  STORED  IN  THE  ARRAY 

*) 

(* 

FLDT 

I 

THE  TYPE  OF  ARRAY  (GLOBAL,  STRUCTURE, 

*) 

(* 

ENTITY) 

*) 

c* 

NEXT_OP 

0 

ENUMERATED  TYPE  INDICATING  THE  NEXT 

*) 

(* 

OPERATION 

*) 

(* 

RR 

0 

INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 

*) 

(* 

IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 

*) 

(* 

*) 

(* 

$ COMMONS: 

*) 

(* 

NONE 

*) 

(* 

*> 

(* 

^ENVIRONMENT: 

*) 

<* 

LANGUAGE: 

IBM  PASCAL 

*) 

(* 

HARDWARE 

SYSTEM: 

IBM  360/370/4341/4381 

*) 
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(* 

DDNAMES  USED  WITH  STANDARD  FILES: 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

DISPLAY  THE  REVIEW  FIELD  PANEL  (REFIELD2) 

BY  MAKING  ISPLNK 

*) 

(* 

CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED 

*) 

(* 

TYPE. 

*) 

(* 

*) 

(* 

$ COMMENTS : 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

*) 

(* 

REVISED:  09/28/87  C.  H.  MOHME 

DBMA 

*) 

(* 

INCORPORATED  THE  SUPERTYPE  DATA  TYPE. 

*) 

<* 

*) 

(* 

REVISED:  08/13/87  C.  II.  MOHME 

DBMA 

*) 

(* 

CHANGED  PANEL  OPTION  NUMBERS;  CHANGED  FIELD 

ADB  DATA;  ADDED 

*) 

(* 

LIST  AND  SET.  NOTE:  THE  LIST  AND  SET  DATA 

TYPES  ARE  IMPLE- 

*) 

(* 

MENTED  IN  THE  SOFTWARE  AS  AN  ARRAY.  A  FIELD 

i  WAS  ADDED  TO  THE 

*) 

(* 

ARRAY  ADB  TO  SPECIFY  WHETHER  THE  ARRAY  IS  A 

CONCEPTUAL  ARRAY, 

*) 

(* 

LIST,  OR  SET. 

*) 

(* 

*) 

(* 

REVISED:  07/02/87  C.  H.  MOHME 

DBMA 

*) 

(* 

CHANGED  CURSOR  POSITIONING. 

*) 

(* 

*) 

(* 

ORIGINATED:  07/07/86  C.  H.  MOHME 

DBMA 

*) 

(* 

*) 

(*- 

._*) 

(* 

*) 

(*END - 

._*) 

(* 

END  /.INCLUDE  REFIELD2  *) 
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(*  %INCLUDE  REFSUP  *) 

(**) 

PROCEDURE  REFSUP(VAR  IRC  :  RET_REC ; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  TOKEN_VALUE  :  T_TOKEN_VALUE) ; 

SUBPROGRAM; 

<**) 

(* - - - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  BATCH  INTERFACE  ROUTINE  THAT  ATTEMPTS  TO  RESOLVE  A  *) 

(*  REFERENCE  TO  A  SUPERTYPE.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  TRANSACTION  STACK  *) 

(*  TOKENJVALUE  I/O  TOKEN  VALUE  FROM  BATCH  INPUT  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  BATCH  INPUT  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  *) 

(*  INITIALIZE  VARIABLES  *) 

(*  DETERMINE  IF  THE  SUPERTYPE  HAS  ALREADY  BEEN  MODELED.  *) 

(*  IF  SUPERTYPE  MODELED,  PUSH  ITS  KEY  ONTO  THE  TRANSACTION  STACK.  *) 

(*  IF  SUPERTYPE  NOT  MODELED,  PUSH  UNRESOLVED  TRANSACTION  ONTO  THE  *) 

(*  TRANSACTION  STACK.  *) 

(*  *) 

(*  $ COMMENTS :  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  09/29/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  %TNCLUDE  REFSUP  *) 
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(*  ^INCLUDE  REINTGR  *) 

(**) 

PROCEDURE  REINTGR(VAR  MESS  :  MESSAGE; 

VAR  PREC  :  CHAR8 ; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  REVIEW  INTEGER  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  PREC  0  THE  PRECISION  OF  THE  INTEGER  ENTERED  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *> 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  REVIEW  INTEGER  PANEL  (REINTGR)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  *) 

(*  *) 

(*  $ COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  RELIST  *) 

(**) 

PROCEDURE  RELIST (VAR  MESS 
VAR  MIN 
VAR  MAX 
VAR  FTYPE 
VAR  NEXTJDP 
VAR  RR 

SUBPROGRAM; 


MESSAGE; 
CHAR8 ; 

CHAR8 ; 
CHAR12; 
OPERATIONS ; 
RET_REC) ; 


(**) 


(*- 

-*) 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

THIS  FUNCTION: 

*) 

(* 

DISPLAYS  THE  REVIEW  LIST  PANEL. 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 
c  * 

NAME 

I/O  DESCRIPTION 

*) 

(* 

MESS 

I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 

*) 

(* 

MIN 

I  THE  MINIMUM  NUMBER  OF  OCCURRENCES  IN  THE 

*) 

(* 

LIST 

*) 

(* 

MAX 

I  THE  MAXIMUM  NUMBER  OF  OCCURRENCES  IN  THE 

*) 

(* 

LIST 

*) 

(* 

FTYPE 

I  THE  LIST  TYPE 

*) 

(* 

NEXT_OP 

0  ENUMERATED  TYPE  INDICATING  THE  NEXT 

*) 

(* 

OPERATION 

*) 

(* 

RR 

0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 

*) 

(* 

IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 

*) 

(* 

*) 

(* 

$ COMMONS : 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

DDNAMES  USED  WITH  STANDARD  FILES: 

*) 

(* 

NONE 

*) 

<* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*> 

(* 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

DISPLAY  THE 

REVIEW  LIST  PANEL  (RELIST)  BY  MAKING  ISPLNK 

*) 

(* 

CALLS.  THE 

OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED 

*) 

(* 

TYPE. 

*) 

(* 

*) 
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(*  $  COMMENTS : 

(*  NONE 

(*  *) 

(*  $ CHANGE  CONTROL: 

(*  *) 


*) 
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(*  %INCLUDE  REPNTR  *) 

(**) 

PROCEDURE  REPNTR (VAR  MESS  :  MESSAGE; 

VAR  MEMBERS  :  T_ARRAYTV ; 

VAR  ARRAY_SIZE  :  INTEGER; 

VAR  MEMBER  :  T_NAME; 

VAR  NEXT_0P  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  REVIEW  POINTER  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  MEMBERS  I  THE  ARRAY  OF  MEMBERS  TO  SELECT  FROM  *) 

(*  ARRAY_SIZE  I  THE  SIZE  OF  THE  ARRAY  OF  MEMBERS  *) 

(*  MEMBER  0  THE  MEMBER  SELECTED  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

<*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

<*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  REVIEW  POINTER  PANEL  (REPNTR)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  *) 

<*  *) 
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(* 

^COMMENTS : 

(* 

NONE 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

<* 

*) 

*) 
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(*  %INCLUDE  REREAL  *) 

(**) 

PROCEDURE  REREAL (VAR  MESS  :  MESSAGE; 

VAR  SIZE  :  CHAR8; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  REVIEW  REAL  PANEL  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  SIZE  0  THE  SIZE  OF  THE  REAL  ENTERED  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  $ EXE CUT I ON  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  REVIEW  REAL  PANEL  (REREAL)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  *) 

<*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  RESET  *) 

(**) 

PROCEDURE  RESET (VAR  MESS 
VAR  MIN 
VAR  MAX 
VAR  FTYPE 
VAR  NEXT_OP 
VAR  RR 

SUBPROGRAM; 

(**) 


MESSAGE; 

CHAR8; 

CHAR8 ; 
CHAR12; 
OPERATIONS; 
RET_REC) ; 


<*■ 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 


^FUNCTION: 

THIS  FUNCTION: 

DISPLAYS  THE  REVIEW  SET  PANEL. 

^DESCRIPTION  OF  ARGUMENTS: 

NAME 

MESS 
MIN 

MAX 

FTYPE 
NEXT_OP 

RR 


^COMMONS : 

NONE 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

DDNAMES  USED  WITH  STANDARD  FILES: 

NONE 

^EXECUTION  PROCEDURE: 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

^PROCESSING  DESCRIPTION: 

DISPLAY  THE  REVIEW  SET  PANEL  (RESET)  BY  MAKING  ISPLNK 
CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED 
TYPE. 


I/O  DESCRIPTION 

I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 
I  THE  MINIMUM  NUMBER  OF  OCCURRENCES  IN  THE 
LIST 

I  THE  MAXIMUM  NUMBER  OF  OCCURRENCES  IN  THE 
LIST 

I  THE  SET  TYPE 

0  ENUMERATED  TYPE  INDICATING  THE  NEXT 
OPERATION 

0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 
IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 


T 
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(*  ^COMMENTS:  *) 
(*  NONE  *) 
(*  *) 
(*  | CHANGE  CONTROL:  *) 
(*  *) 
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(*  %INCLUDE  RESTRING  *) 

(**) 

PROCEDURE  RESTRING(VAR  MESS  :  MESSAGE; 

VAR  SLEN  :  CHAR8 ; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  REVIEW  STRING  PANEL  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  SIZE  0  THE  SIZE  OF  THE  STRING  ENTERED  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

<*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  REVIEW  STRING  PANEL  (RESTRING)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  *) 

<*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  RESTRUC  *) 

(**) 

PROCEDURE  RESTRUC(VAR  MESS  :  MESSAGE; 

VAR  MEMBERS  :  T_ARRAYID; 

VAR  SIZE  :  INTEGER; 

VAR  MEMBER  :  T_NAME; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  REVIEW  STRUCTURE  PANEL  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS :  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  MEMBERS  I  THE  ARRAY  OF  MEMBERS  TO  SELECT  FROM  *) 

(*  SIZE  I  THE  SIZE  OF  THE  ARRAY  OF  MEMBERS  *) 

(*  MEMBER  0  THE  MEMBER  SELECTED  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  REVIEW  STRUCTURE  PANEL  (RESTRUC)  BY  MAKING  *) 

(*  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  *) 

(*  ENUMERATED  TYPE.  *) 

(*  *) 
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(*  $ COMMENTS : 

(*  NONE 

(* 

(*  $ CHANGE  CONTROL: 
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(*  %INCLUDE  RESUBS CM  *) 

(**) 

PROCEDURE  RESUBSCM(VAR  MESS  :  MESSAGE; 

VAR  NAME  :  T_NAME; 

VAR  COMMENT  :  CHAR150; 

VAR  MEMBERS  :  T_ARRAYTV ; 

VAR  SIZE  :  INTEGER; 

VAR  MEMBER  :  T_NAME; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  REVIEW  SUBSCHEMA  PANEL  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NAME  I  THE  SUBSCHEMA  NAME  *) 

(*  MEMBERS  I  THE  ARRAY  OF  MEMBERS  TO  SELECT  FROM  *) 

(*  SIZE  I  THE  SIZE  OF  THE  ARRAY  OF  MEMBERS  *) 

(*  MEMBER  0  THE  MEMBER  SELECTED  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  REVIEW  SUBSCHEMA  PANEL  (RESUBSCM)  BY  MAKING  *) 

(*  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  *) 

(*  ENUMERATED  TYPE.  *) 
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(*  ^COMMENTS:  *) 
(*  NONE  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 
(*  *) 
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(*  %INCLUDE  RESUPTYP  *) 

(**) 

PROCEDURE  RESUPTYP (VAR  MESS  :  MESSAGE; 

VAR  NAME  :  T_NAME; 

VAR  NEXTJJP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  PROCEDURE  :  *) 

(*  DISPLAYS  THE  REVIEW  SUPERTYPE  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NAME  I  THE  SUPERTYPE  NAME  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

<*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

<*  DISPLAY  THE  REVIEW  SUPERTYPE  PANEL  (RESUPTYP)  BY  MAKING  *) 

(*  '  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  *) 

(*  ENUMERATED  TYPE.  *) 

(*  *) 

(*  ^COMMENTS:  *j 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  BEGIN  %INCLUDE  RSCPAI  **********************************************) 
(*  *) 


PROCEDURE  RSCPAI  (  VAR 

OUTPUT_VALUE  :  T_DATA_VALUE ; 

CONST 

INPUT_VALUE  :  T_ARRAY_INDEX; 

CONST 

SIZE_OF„VALUE  :  INTEGER); 

EXTERNAL; 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

COPY  THE  ARRAY 

INDEX  TABLE  INFORMATION  INTO  THE  RUN-TIME 

*) 

(* 

SUBSCHEMA. 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

c* 

NAME 

I/O  DESCRIPTION 

*) 
*  ^ 

(* 

INPUT_VALUE 

I  INPUT  VALUE  OF  ARBITRARY  SIZE 

*) 

(* 

OUTPUT_VALUE 

0  OUTPUT  VALUE  OF  ARBITRARY  SIZE 

*) 

(* 

S I ZE_OF_VALUE 

I  SIZE  OF  VALUE  TO  BE  COPIED 

*) 

(* 

*) 

(* 

^COMMONS: 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

RUN-TIME  SUBSCHEMA 

*> 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

<* 

CALL  MACHINE  DEPENDENT  ROUTINE  TO  COPY  ARRAY  TABLE  INFO 

*) 

(* 

*) 

(* 

$ COMMENTS : 

*) 

(* 

*) 

<* 

^CHANGE  CONTROL: 

*) 

<* 

ORIGINATED:  01 

OCTOBER  1986,  M.  H.  CHOI,  DBMA 

*) 

<* 

*) 

(* 

END  %INCLUDE  RSCPAI  ************************************************) 
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(*  BEGIN  XINCLUDE  RSCPAT  **********************************************) 


(*  *) 

PROCEDURE  RSCPAT  (  VAR  OUTPUT_VALUE  :  T_DATA_VALUE ; 

CONST  INPUT_VALUE  :  T_ARRAY_LIST ; 

CONST  S I ZE_OF_VALUE  :  INTEGER); 

EXTERNAL; 

(*  *) 

(*  $ FUNCTION:  *) 

(*  COPY  THE  SIZE  AND  THE  LOWER  BOUND  OF  THE  ARRAY  INTO  THE  *) 

(*  RUN-TIME  SUBSCHEMA.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS :  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  INPUT_VALUE  I  INPUT  VALUE  OF  ARBITRARY  SIZE  *) 

(*  OUTPUT_VALUE  0  OUTPUT  VALUE  OF  ARBITRARY  SIZE  *) 

(*  S I ZE_0 F_VALUE  I  SIZE  OF  VALUE  TO  BE  COPIED  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  RUN-TIME  SUBSCHEMA  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  CALL  MACHINE  DEPENDENT  ROUTINE  TO  COPY  THE  SIZE  AND  THE  *) 

(*  LOWER  BOUND  OF  THE  ARRAY  *) 

(*  *) 

(*  $ COMMENTS :  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  ORIGINATED:  01  OCTOBER  1986,  M.  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  XINCLUDE  RSCPAT  ************************************************) 
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(*  BEGIN  %INCLUDE  RSCPCI  **********************************************) 


(*  *) 

PROCEDURE  RSCPCI  (  VAR  OUTPUT_VALUE  :  T_DATA_VALUE ; 

CONST  INPUT_VALUE  :  T_CL_INDEX; 

CONST  S I ZE_0 F_VALUE  :  INTEGER); 

EXTERNAL; 

(*  *) 

(*  $ FUNCTION:  *) 

(*  COPY  THE  POINTER  INDEX  TABLE  INFORMATION  INTO  THE  *) 

(*  RUN-TIME  SUBSCHEMA.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  INPUT.VALUE  I  INPUT  VALUE  OF  ARBITRARY  SIZE  *) 

(*  OUTPUT_VALUE  0  OUTPUT  VALUE  OF  ARBITRARY  SIZE  *) 

(*  SIZE  OF_VALUE  I  SIZE  OF  VALUE  TO  BE  COPIED  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  RUN-TIME  SUBSCHEMA  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  CALL  MACHINE  DEPENDENT  ROUTINE  TO  COPY  CL  INDEX  INFO  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  ORIGINATED:  29  JANUARY  1987,  M.  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  %INCLUDE  RSCPCI  ************************************************) 
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(*  BEGIN  %INCLUDE  RSCPCT  **********************************************) 
(*  °  *) 


PROCEDURE  RSCPCT  (  VAR 

OUTPUT.VALUE  :  T_DATA_VALUE ; 

CONST 

INPUT_VALUE  :  T_CL_KINDS; 

CONST 

S I ZE_OF_VALUE  :  INTEGER); 

EXTERNAL; 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

COPY  THE  KINDS 

OF  POINTERS  INTO  THE  RUN-TIME  SUBSCHEMA. 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

(* 

NAME 

I/O  DESCRIPTION 

*) 
* 'i 

(*  INPUT_VALUE  I  INPUT  VALUE  OF  ARBITRARY  SIZE  *) 


(* 

OUTPUT.VALUE 

0  OUTPUT  VALUE  OF  ARBITRARY  SIZE 

*) 

(* 

S I ZE_OF_VALUE 

I  SIZE  OF  VALUE  TO  BE  COPIED 

*) 

(* 

*) 

(* 

$ COMMONS : 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

(SEGMENT  SUBPROGRAM) 

*) 

(* 

HARDWARE  SYSTEM:  IBM 

360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

RUN-TIME  SUBSCHEMA 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

CALL  MACHINE  DEPENDENT  ROUTINE  TO  COPY  KINDS  OF  POINTER 

*) 

(* 

*) 

(* 

$ COMMENTS : 

*) 

(* 

*) 

(* 

^CHANGE  CONTROL: 

*) 

(* 

ORIGINATED:  29  JANUARY  1987,  M.  H.  CHOI,  DBMA 

*) 

(* 

*) 

(* 

END  XINCLUDE  RSCPCT  ************************************************) 
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(*  BEGIN  %INCLUDE  RSCPEI  **********************************************) 
(*  *) 
PROCEDURE  RSCPEI  (  VAR  OUTPUT_VALUE  :  T_DATA_VALUE ; 

CONST  INPUT_VALUE  :  T_ENUM_INDEX; 

CONST  S I ZE_OF_VALUE  :  INTEGER); 

EXTERNAL; 

(*  *) 

(*  $ FUNCTION:  *) 

(*  COPY  THE  ENUMERATION  INDEX  TABLE  INFORMATION  INTO  THE  *) 

(*  RUN-TIME  SUBSCHEMA.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  INPUT.VALUE  I  INPUT  VALUE  OF  ARBITRARY  SIZE  *) 

(*  OUTPUT_VALUE  0  OUTPUT  VALUE  OF  ARBITRARY  SIZE  *) 

(*  S I ZE_OF_VALUE  I  SIZE  OF  VALUE  TO  BE  COPIED  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  RUN-TIME  SUBSCHEMA  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  CALL  MACHINE  DEPENDENT  ROUTINE  TO  COPY  ENUMERATION  INFO  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  ORIGINATED:  01  OCTOBER  1986,  M.  H.  CHOI,  DBMA  *) 

(*  *) 

(*  END  %INCLUDE  RSCPEI  ************************************************) 
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(*  BEGIN  %INCLUDE  RSCPET  **********************************************) 
(*  *) 

PROCEDURE  RSCPET  (  VAR  OUTPUT_VALUE  :  T_DATA_VALUE ; 

CONST  INPUT_VALUE  :  T_ENUMERATION ; 

CONST  S I ZE_OF_VALUE  :  INTEGER); 

EXTERNAL; 

(*  *) 

(*  $ FUNCTION:  *) 

(*  COPY  THE  ENUMERATION  VALUES  INTO  THE  RUN-TIME  SUBSCHEMA.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  INPUT_VALUE  I  INPUT  VALUE  OF  ARBITRARY  SIZE  *) 

(*  OUTPUT_VALUE  0  OUTPUT  VALUE  OF  ARBITRARY  SIZE  *) 

(*  S I ZE_OF_VALUE  I  SIZE  OF  VALUE  TO  BE  COPIED  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  RUN-TIME  SUBSCHEMA  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  CALL  MACHINE  DEPENDENT  ROUTINE  TO  COPY  ENUMERATION  TABLE  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  REVISED:  16  MAY  1986,  GEORGE  A.  WHITE,  FRMI ,  REORGANIZED  *) 

(*  GLOBAL  DECLARATIONS  INTO  'NVITYP'.  *) 

(*  ORIGINATED:  15  OCTOBER  1985,  G.  A.  WHITE,  FRMI  *) 

<*  *) 

(*  END  %INCLUDE  RSCPET  ************************************************) 
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(*  BEGIN  %INCLUDE  RSFILE  **********************************************) 


(*  *) 

PROCEDURE  RSFILE  (  VAR  SUBSCHEMA_KEY  :  ENTKEY; 

VAR  IRC  :  RET_REC  ); 

SUBPROGRAM; 

(*  *) 

(*  $ FUNCTION:  *) 

(*  FILE  RUN-TIME  SUBSCHEMA  INTO  SEQUENTIAL  FILE  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  SUBSCHEMAJCEY  I  SUBSCHEMA  KEY  OF  THE  ENTITY  DEFINITIONS  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  =0  SUCCESS  *) 

(*  >  0  CRITICAL  ERROR:  *) 

(*  *) 

(*  $COMMONS :  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  RUN-TIME  SUBSCHEMA  *) 

(*  CALLED  FROM  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  OPEN  DATAFILE  *) 

(*  OPEN  INXFILE  *) 

(*  WRITE  ARRAY_ENTITY  (1100)  IF  THERE  IS  ARRAY  OF  POINTER  *) 

(*  IN  THE  ENTITY  DEFINITIONS  *) 

(*  LOOP  THROUGH  LIST  OF  SUBSCHEMA  *) 

(*  GET  RUNJTIME  SUBSCHEMA  (  RSGTSM  )  *) 

(*  WRITE  KIND,  RECORD  NO,  OFFSET,  RUNTIME_SIZE  INTO  INXFILE  *) 

(*  FOR  INDEX  :=  1  TO  RUNTIME_SIZE  *) 

(*  WRITE  RUNTIME  SUBSCHEMA  INTO  DATAFILE  *) 

(*  END  LOOP  *) 

(*  CLOSE  DATAFILE  *) 

(*  CLOSE  INXFILE  *) 

<*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  ORIGINATED:  27  JANUARY  1987,  M.  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  XINCLUDE  RSFILE  ************************************************) 
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(*  BEGIN  %INCLUDE  RSGTSM  **********************************************) 
(*  *) 


PROCEDURE  RSGTSM  (  CONST 

ENTITYJCEY  :  ENTKEY; 

VAR 

RUN. 

.TIME  :  T_RUN_TIME; 

VAR 

RUN. 

"TIME_SIZE  :  INTEGER; 

VAR 

IRC 

:  RET_REC  ); 

SUBPROGRAM; 

(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

BUILD  RUN-TIME 

SUBSCHEMA  FROM  SCHEMA  MODEL 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

NAME 

I/O 

DESCRIPTION 

*) 

(* 

ENTITY  JCEY 

I 

KEY  FROM  SCHEMA  MODEL  WHICH  THE 

/ 

*) 

(* 

TRANSLATION  WILL  BE  PERFORMED. 

*) 

(* 

IRC 

0 

RETURN  CODE 

*) 

(* 

=  0  SUCCESS 

*) 

(* 

>  0  CRITICAL  ERROR: 

*) 

(* 

RUNJTIME 

0 

RUN-TIME  SUBSCHEMA  WHICH  CONTAINS  THE 

*) 

(* 

ENTITY  DEFINITION,  ALONG  WITH  ANY 

*) 

(* 

ENUMERATION  VALUES,  CONSTITUENT  LIST, 

*) 

(* 

AND  ARRAY  INFORMATION,  IN  A  COMPACTED 

*) 

(* 

FORM. 

*) 

(* 

RUN_TIME_SIZE 

0 

THE  NUMBER  OF  BYTES  ACTUALLY  REQUIRED 

*) 

(* 

FOR  THE  COMPACTED  RUN-TIME  SUBSCHEMA. 

*) 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


*) 

^COMMONS:  *) 

*) 

^ENVIRONMENT:  *) 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

*) 

^EXECUTION  PROCEDURE:  *) 

RUN-TIME  SUBSCHEMA  *) 

CALLED  FROM  THE  NAME/VALUE  INTERFACE  *) 

*) 

^PROCESSING  DESCRIPTION:  *) 

TRANSLATE  SCHEMA  MODEL  ENTRY  INTO  ENTITY  ATTRIBUTES  *) 

AND  ENUMERATION  VALUES  AND  ARRAY  INFORMATION  *) 

IF  THERE  WERE  ANY  ENUMERATION  ATTRIBUTES  THEN  *) 

CALCULATE  THE  STARTING  POSITION  OF  THE  ENUMERATION  *) 

INDEX  TABLE  AND  STORE  INTO  RUN-TIME  SUBSCHEMA  *) 

DETERMINE  THE  ACTUAL  SIZE  OF  THE  ENUMERATION  INDEX  TABLE  *) 
COPY  ENUMERATION  INDEX  TABLE  INFORMATION  INTO  RUN-TIME  *) 

SUBSCHEMA  *) 


(*  ENDIF 


*) 
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(*  IF  THERE  WERE  ANY  ENUMERATION  ATTRIBUTES  THEN  *) 
(*  CALCULATE  THE  STARTING  POSITION  OF  THE  ENUMERATION  *) 
(*  VALUE  TABLE  AND  STORE  INTO  RUN-TIME  SUBSCHEMA  *) 
(*  DETERMINE  THE  ACTUAL  SIZE  OF  THE  ENUMERATION  VALUE  TABLE  *) 
(*  COPY  THE  ENUMERATION  VALUES  INTO  THE  RUN-TIME  SUBSCHEMA  *) 
(*  END IF  *) 
(*  IF  THERE  WERE  ANY  ARRAY  ATTRIBUTES  THEN  *) 
(*  CALCULATE  THE  STARTING  POSITION  OF  THE  ARRAY  INDEX  TABLE  *) 
(*  AND  STORE  INTO  RUN-TIME  SUBSCHEMA  *) 
(*  DETERMINE  THE  ACTUAL  SIZE  OF  THE  ARRAY  INDEX  TABLE  *) 
(*  COPY  ARRAY  TABLE  INDEX  INFORMATION  INTO  RUN-TIME  SUBSCHEM*) 
(*  ENDIF  *) 
C*  IF  THERE  WERE  ANY  ARRAY  ATTRIBUTES  THEN  *) 
(*  CALCULATE  THE  STARTING  POSITION  OF  THE  ARRAY  LIST  TABLE  *) 
(*  AND  STORE  INTO  RUN-TIME  SUBSCHEMA  *) 
(*  DETERMINE  THE  ACTUAL  SIZE  OF  THE  ARRAY  LIST  TABLE  *) 
(*  COPY  ARRAY  LIST  INFORMATION  INTO  RUN-TIME  SUBSCHEMA  *) 
(*  ENDIF  *) 
(*  CALCULATE  THE  SIZE  OF  THE  RUN-TIME  SUBSCHEMA  *) 

C*  *) 

(*  ^COMMENTS:  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 
(*  REVISED:  15  SEPTEMBER  1987,  M.  H.  CHOI,  DBMA  *) 
(*  ADDED  SUPER  TYPE  IN  THE  ENTITY  *) 
(*  REVISED:  12  AUGUST  1987,  M.  H.  CHOI,  DBMA  *) 
(*  ADDED  MINIMUM  OCCURRENCES  TO  ATTRIBUTE  *) 
(*  ORIGINATED:  11  AUGUST  1986,  M.  H.  CHOI,  FRMI  *) 
(*  *) 
(*  END  %INCLUDE  RSGTSM  ************************************************) 
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(*  BEGIN  %INCLUDE  RSMASKND  ********************************************) 
(*  *) 
PROCEDURE  RSMASKND  (  VAR  ENTITY  :  T_SCHEMA  ); 


SUBPROGRAM; 


(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

INSERT  THE  MODEL  ACCESS 

SOFTWARE(MAS)  ATTRIBUTES  (  KIND, 

*) 

(* 

LENGTH,  SYSUSE  )  INTO  A 

RUN-TIME  SUBSCHEMA. 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  ENTITY  0  RUN-TIME  SUBSCHEMA  ENTITY  DEFINITION.*) 


(* 

*) 

(* 

$ COMMONS : 

*) 

<* 

*) 

(* 

^ENVIRONMENT : 

*) 

(* 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

*) 

<* 

^EXECUTION  PROCEDURE: 

*) 

(* 

NAME/VALUE  INTERFACE 

*) 

(* 

CALLED  FROM  THE  NAME/VALUE  INTERFACE 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

INSERT  KIND,  LENGTH,  SYSUSE  ATTRIBUTES  INTO 

A  RUN-TIME 

*) 

(* 

SUBSCHEMA  ENTITY  DEFINITION. 

*) 

(* 

*) 

<* 

^COMMENTS : 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

<* 

REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION) 

*) 

(* 

ORIGINATED:  15  SEPTEMBER  1987,  M.  H.  CHOI, 

DBMA 

*) 

(* 

*) 

(*  END  %INCLUDE  RSMASKND  **********************************************) 
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(*  BEGIN  %INCLUDE  RSORDER  *********************************************) 


(*  *) 
PROCEDURE  RSORDER  (  CONST  RUNTIME  :  T_RUN_TIME ; 

VAR  PS_ORDER  :  T_PS_ORDER  ); 

SUBPROGRAM; 

(*  *) 

(*  $ FUNCTION:  *) 

(*  DETERMINE  THE  PHYSICAL  SCHEMA  ORDER  OF  ENTITY  DEFINITION  *) 

(*  BY  ITS  OFFSET.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  RUNTIME  I  CONTAINS  THE  ENTITY  DEFINITION  *) 

(*  PS_ORDER  0  LIST  OF  ATTRIBUTES  IN  PHYSICAL  *) 

(*  ORDER  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  CALLED  FROM  EITHER  PASCAL  OR  FORTRAN  APPLICATION  PROGRAM  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  LOOP  THROUGH  THE  NUMBER  OF  ATTRIBUTES  IN  THE  DEFINITION  *) 

(*  INSERT  THE  OFFSET  IN  THE  PHYSICAL  SCHEMA  ORDER  TABLE  *) 

(*  END  LOOP  *) 

(*  LOOP  THROUGH  THE  NUMBER  OF  ATTRIBUTES  IN  THE  DEFINITION  *) 

(*  IF  CURRENT  OFFSET  GREATER  THAN  NEXT  OFFSET  THEN  *) 

(*  SWITCH  CURRENT  OFFSET  WITH  NEXT  OFFSET  *) 

(*  END  IF  *) 

(*  END  LOOP  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  ORIGINATED:  27  JANUARY  1988,  M.  H.  CHOI,  DBMA  *) 

(*  *) 


(*  END  %INCLUDE  RSORDER  ***********************************************) 
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(*  BEGIN  %INCLUDE  RSTKGF  *****************************-****************) 
(*  *) 
PROCEDURE  RSTRGF  (  VAR  ENTITY  :  T_SCHEMA; 

VAR  ENUM  :  T_ENUM_COMPACTOR; 

VAR  ENUM_INDEX  :  T_ENUM_INX_COMPACTOR ; 

VAR  ARRAY_LIST  :  T_ARRAY_LIST_COMPACTOR ; 

VAR  ARRAY_INDEX  :  T_ARRAY_INX_COMPACTOR ; 

VAR  CL_INDEX  :  T_CL_INX_COMPACTOR ; 

VAR  CL_LIST  :  T_CL_KINDS_COMPACTOR j 

VAR  IRC  :  RET_REC  ); 

SUBPROGRAM; 


(*  *) 

(*  $ FUNCTION:  *) 

(*  TRANSLATE  THE  GLOBAL  FIELDS  INTO  A  RUN-TIME  SUBSCHEMA  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  ENTITY  0  RUN-TIME  SUBSCHEMA  WHICH  CONTAINS  THE  *) 

(*  ENTITY  DEFINITION  *) 

(*  ENUM  0  ENUMERATION  VALUES  *; 

(*  ENUM_INDEX  0  ENUMERATION  INDEX  TABLE  *> 


(*  ARRAY_LIST  0  LOWER  BOUND  AND  ARRAY  SIZE  *) 
(*  ARRAY_INDEX  0  ARRAY  INDEX  TABLE  *) 
(*  CL_INDEX  0  CONSTITUENT  INDEX  TABLE  *) 
(*  CL_LIST  0  CONSTITUENT  KINDS  *) 
(*  IRC  0  RETURN  CODE  *) 
(*  =0  SUCCESS  *) 
(*  *) 
(*  $ COMMONS :  •  *) 

(*  *) 
(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM)  *) 
(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 
(*  *) 
(*  ^EXECUTION  PROCEDURE:  *) 
(*  RUN-TIME  SUBSCHEMA  *) 
(*  CALLED  FROM  THE  NAME/VALUE  INTERFACE  *) 
(*  *) 
(*  ^PROCESSING  DESCRIPTION:  *) 
(*  INITIALIZE  TABLE  INDEXES  *) 
<*  MAKE  A  LIST  OF  GLOBAL  KINDS 


(*  LOOP  THROUGH  A  LIST  OF  GLOBAL  KINDS 

(*  TRANSLATE  GLOBAL  FIELD  INTO  A  RUN-TIME  SUBSCHEMA 

(* 

(*  $ COMMENTS : 

(* 


*) 

*) 

*) 

*) 

*) 
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(*  $ CHANGE  CONTROL:  *) 

(*  ORIGINATED:  20  NOVEMBER  1986,  M.  H.  CHOI,  DBMA  *) 

(*  *) 
(*  END  %INCLUDE  RSTRGF  ************************************************) 
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(*  BEGIN  %INCLUDE  RSTRSM  **********************************************) 


PROCEDURE  RSTRSM  (  CONST  ENTITY JCEY 


VAR 

VAR 

VAR 

VAR 

VAR 

VAR 

VAR 

VAR 

SUBPROGRAM; 


ENTITY 

ENUM 

ENUM_INDEX 

ARRAY_LIST 

ARRAY_INDEX 

CL.INDEX 

CL_LIST 

IRC 


LISTKEY; 

T_SCHEMA; 
T_ENUM_COMPACTOR ; 
T_ENUM_INX_COMPACTOR ; 
T_ARRAY_LIST_COMPACTOR ; 
T_ARRAY_INX_COMPACTOR ; 
T_CL_INX_COMPACTOR ; 
T_CL_KINDS_COMPACTOR ; 
RET_REC  ); 


^FUNCTION: 

TRANSLATE  A  SCHEMA  MODEL  ENTRY  INTO  A  RUN-TIME  SUBSCHEMA 
ENTITY,  ENUMERATION  TABLE  AND  ARRAY  INFO  TABLE. 


^DESCRIPTION  OF  ARGUMENTS: 


DESCRIPTION 


ARRAY  INDEX 


ARRAY  LIST 


ENUM_INDEX 

ENTITY 

ENTITY_KEY 


RUN-TIME  SUBSCHEMA  ARRAY  TABLE  INDEX  *) 
INFORMATION.  *) 
RUN-TIME  SUBSCHEMA  ARRAY  TABLE  *) 
AND  COMPACTION  INFORMATION.  *) 
RUN-TIME  SUBSCHEMA  ENUMERATION  TABLE  *) 
AND  COMPACTION  INFORMATION.  *) 
RUN-TIME  SUBSCHEMA  ENUMERATION  TABLE  *) 
INDEX  INFORMATION.  *) 
RUN-TIME  SUBSCHEMA  ENTITY  DEFINITION.*) 
KEY  FROM  SCHEMA  MODEL  WHICH  THE  *) 
TRANSLATION  WILL  BE  PERFORMED.  *) 
RETURN  CODE  *) 
=  0  SUCCESS  *) 
>  0  CRITICAL  ERROR:  *) 


^COMMONS : 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 
HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

NAME/VALUE  INTERFACE 

CALLED  FROM  THE  NAME/VALUE  INTERFACE 


^PROCESSING  DESCRIPTION: 

OBTAIN  ENTITY  NAME  AND  KIND  FROM  SCHEMA  MODEL 
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(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 


STORE  ENTITY  NAME  AND  KIND  INTO  RUN-TIME  SUBSCHEMA  *) 

LOOP  THROUGH  SCHEMA  MODEL  ENTRIES  *) 

OBTAIN  ATTRIBUTE  ENTRY  FROM  SCHEMA  MODEL  *) 

CASE  DATA  TYPE  OF  *) 

INTEGER,  REAL,  STRING,  LOGICAL  •  *) 


:  APPLICATION_DATA_BLOCK_ATTRIBUTE,  PROCEDURE  (1)  *) 
POINTER  :  CONSTITUENT_LIST_ATTRIBUTE,  PROCEDURE  (2)  *) 
ARRAY  :  ARRAY_ATTRIBUTE ,  PROCEDURE  (3)  *) 

DEFINEDJTYPE  :  DEFINED_TYPE_ATTRIBUTE ,  PROCEDURE  (4)  *) 
OTHERWISE  :  ERROR  MESSAGE  =  'UNKNOWN  ATTRIBUTE  TYPE'  *) 
ENDCASE  *) 

ENDLOOP  *) 


(*  PROCEDURE  (1)  :  APPLICATION_DATA_BLOCK_ATTRIBUTE  *) 
(*  STORE  ATTRIBUTE  DEFINITION  FOR  TYPE  IN  SCHEMA  MODEL  ENTRY  *) 
(*  *) 
(*  PROCEDURE  (2)  :  CONSTITUENT_LIST_ATTRIBUTE  *) 
(*  OBTAIN  CONSTITUENT  LIST  POSITION  FROM  SCHEMA  MODEL  *) 
(*  STORE  ATTRIBUTE  DEFINITION  FOR  TYPE  IN  SCHEMA  MODEL  ENTRY  *) 
(*  *) 
(*  PROCEDURE  (3)  :  ARRAY_ATTRIBUTE  *) 
(*  DETERMINE  THE  NUMBER  OF  ARRAY  DIMENSIONS  *) 
(*  STORE  ARRAY  INFORMATION  INTO  RUN-TIME  SUBSCHEMA  *) 
(*  STORE  TABLE  INDEX  POSITION  FOR  ARRAY  LIST  TABLE  AND  THE  *) 
(*  NUMBER  OF  DIMENSIONS  INTO  ARRAY  INDEX  TABLE  *) 
(*  CALCULATE  TOTAL  SIZE  OF  THE  ARRAY  AND  STORE  INTO  ARRAY  *) 
(*  INDEX  TABLE  *) 
(*  FOR  THE  NUMBER  OF  ARRAY  DIMENSIONS  *) 
(*  CALCULATE  THE  SIZE  OF  EACH  ARRAY  *) 
(*  STORE  SIZE  AND  LOW-BOUND  INTO  ARRAY  LIST  TABLE  *) 
(*  END  LOOP  *) 
(*  *) 
(*  PROCEDURE  (4)  :  DEFINED_TYPE_ATTRIBUTE  *) 
(*  OBTAIN  DATA  TYPE  FOR  DEFINED  TYPE  ATTRIBUTE  IN  SCHEMA  MODEL  *) 
(*  CASE  DATAJTYPE  OF  *) 
(*  INTEGER,  REAL,  STRING,  LOGICAL  *) 
(*  :  APPLI CATI ON_DATA_BLO CK_ATTRI BUTE ,  PROCEDURE  (1)  *) 
(*  ENUMERATION  :  ENUMERATION_ATTRIBUTE,  PROCEDURE  (5)  *) 
(*  POINTER  :  CONSTITUENT_LIST_ATTRIBUTE,  PROCEDURE  (2)  *) 
(*  ARRAY  :  ARRAY_ATTRIBUTE ,  PROCEDURE  (3)  *) 
(*  OTHERWISE  :  ERROR  MESSAGE  =  'UNKNOWN  ATTRIBUTE  TYPE'  *) 
(*  ENDCASE  *) 
(*  *) 
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(*  PROCEDURE  (5)  :  ENUMERATION_ATTRIBUTE  *) 
(*  STORE  ATTRIBUTE  DEFINITION  FOR  ENUMERATION  TYPE  *) 
(*  OBTAIN  NUMBER  OF  ENUMERATION  VALUES  FROM  SCHEMA  MODEL  *) 
(*  STORE  NUMBER  OF  ENUMERATION  VALUE  IN  ENUMERATION  INDEX  TABLE*) 
(*  STORE  ENUMERATION  VALUE  TABLE  INDEX  POSITION  IN  ENUMERATION  *) 
(*  INDEX  TABLE  *) 
(*  LOOP  THROUGH  ENUMERATION  VALUES  *) 
(*  OBTAIN  ENUMERATION  VALUE  FROM  SCHEMA  MODEL  *) 
(*  STORE  ENUMERATION  VALUE  IN  ENUMERATION  VALUE  TABLE  *) 
(*  END  LOOP  *) 

<*  *) 
(*  $ COMMENTS :  *) 

(*  *) 
(*  $ CHANGE  CONTROL:  *) 

(*  REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION)  *) 
(*  ORIGINATED:  06  AUGUST  1986,  M.  H.  CHOI,  FRMI  *) 
(*  *) 


(*  END  %INCLUDE  RSTRSM  ************************************************) 


i 
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(*  BEGIN  %INCLUDE  RSTRST  **********************************************) 
(*  *) 


PROCEDURE  RSTRST  (  CONST 

SUBTYPE_KEY 

ENTKEY; 

VAR 

ENTITY 

T_SCHEMA; 

VAR 

ENUM 

T_ENUM_COMPACTOR ; 

VAR 

ENUM_INDEX 

T_ENUM_INX_COMP ACTOR ; 

VAR 

ARRAY_LIST 

T_ARRAY_LI ST_COMPACTOR ; 

VAR 

ARRAY_INDEX 

T_ARRAY_INX_COMPACTOR ; 

VAR 

CL_INDEX 

T_CL_INX_COMPACTOR ; 

VAR 

CL_LIST 

T_CL_KINDS_COMPACTOR ; 

VAR 

IRC 

RET_REC  ); 

SUBPROGRAM; 

(* 

*) 

(* 

$FUNCTION: 

*) 

(* 

TRANSLATE  SUPER  TYPE  INTO  A  RUN- 

-TIME  SUBSCHEMA 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

(* 

(* 

NAME 

I/O  DESCRIPTION 

*) 

SUBTYPE_KEY 

I  KEY  FROM  SCHEMA  MODEL  WHICH  THE 

J 

*) 

(* 

TRANSLATION  WILL  BE  PERFORMED. 

*) 

(* 

>  0  CRITICAL  ERROR: 

*) 

(* 

ENTITY 

0  RUN-TIME  SUBSCHEMA  WHICH  CONTAINS  THE 

*) 

(* 

ENTITY  DEFINITION 

*) 

<* 

ENUM 

0  ENUMERATION  VALUES 

*) 

(* 

ENUM_INDEX 

0  ENUMERATION 

INDEX  TABLE 

*) 

<* 

ARRAY_LIST 

0  LOWER  BOUND 

AND  ARRAY  SIZE 

*) 

(* 

ARRAY_INDEX 

0  ARRAY  INDEX  TABLE 

*) 

(* 

CL_INDEX 

0  CONSTITUENT 

INDEX  TABLE 

*) 

<* 

CL_LIST 

0  CONSTITUENT 

KINDS 

*) 

(* 

IRC 

0  RETURN  CODE 

*) 

(* 

=  0  SUCCESS 

*) 

(* 

*) 

(* 

$ COMMONS: 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

*> 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

RUN-TIME  SUBSCHEMA 

*) 

(* 

CALLED  FROM  THE  NAME/VALUE  INTERFACE 

*) 

<* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

<* 

MAKE  A  LIST  OF 

SUPER  TYPE 

*) 

(* 

LOOP  THROUGH  A  LIST  OF  SUPER  TYPE 

*) 

(* 

TRANSLATE  SUPER  TYPE  INTO  A- 

RUN-TIME  SUBSCHEMA 

*) 
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(*  ^COMMENTS:  *) 
(*  *) 
(*  $  CHANGE  CONTROL:  *) 
(*  ORIGINATED:  9  SEPTEMBER  1987,  M.  H.  CHOI,  DBMA  *) 
(*  *) 
(*  END  ^INCLUDE  RSTRST  ************************************************) 
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(*  BEGIN  %INCLUDE  RSTRSTC  *********************************************) 
(*  *) 


PROCEDURE  RSTRSTC  (  CONST 

ENTITI 

_KEY  : 

LISTKEY; 

VAR 

S_OFFSET 

INTEGER; 

VAR 

ENTITY 

T_SCHEMA; 

VAR 

ENUM 

T_ENUM_COMPACTOR ; 

VAR 

ENUM_INDEX 

T_ENUM_INX_COMPACTOR ; 

VAR 

ARRAY_ 

LIST 

T_ARRAY_LI ST_COMPACTOR ; 

VAR 

ARRAY. 

INDEX 

T_ARRAY_INX_COMPACTOR ; 

VAR 

CL_INDEX 

T_CL_INX_COMPACTOR ; 

VAR 

CL_LIST 

T_CL_KINDS_COMPACTOR ; 

VAR 

IRC 

RET_REC  ); 

SUBPROGRAM; 

(* 

*) 

(* 

^FUNCTION: 

*) 

<* 

TRANSLATE  A  STRUCTURE 

ATTRIBUTE  INTO  A  RUN-TIME  SUBSCHEMA 

*) 

(* 

ENTITY,  ENUMERATION  TABLE  AND  ARRAY  INFO  TABLE. 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS: 

*) 

(* 

(* 

NAME 

I/O 

DESCRIPTION 

*) 
*  \ 

(* 

ARRAY_INDEX 

0 

RUN-TIME  SUBSCHEMA  ARRAY  TABLE  INDEX 

*) 

(* 

INFORMATION. 

*) 

(* 

ARRAY_LIST 

0 

RUN-TIME  SUBSCHEMA  ARRAY  TABLE 

*) 

(* 

AND  COMPACTION  INFORMATION. 

*) 

(* 

ENUM 

0 

RUN-TIME  SUBSCHEMA  ENUMERATION  TABLE 

*) 

<* 

AND  COMPACTION  INFORMATION. 

*) 

(* 

ENUM_INDEX 

0 

RUN-TIME  SUBSCHEMA  ENUMERATION  TABLE 

*) 

(* 

INDEX  INFORMATION. 

*) 

(* 

\ 

ENTITY 

0 

RUN-TIME  SUBSCHEMA  ENTITY  DEFINITION 

.*) 

(* 

ENTITY_KEY 

I 

KEY  FROM  SCHEMA  MODEL  WHICH  THE 

*\ 

* 

(* 

TRANSLATION  WILL  BE  PERFORMED. 

*) 

(* 

IRC 

0 

RETURN  CODE 

*) 

(* 

=  0  SUCCESS 

*) 

(* 

>  0  CRITICAL  ERROR: 

*) 

(* 

*> 

(* 

$ COMMONS : 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL  (SEGMENT  SUBPROGRAM) 

*) 

<* 

HARDWARE  SYSTEM 

:  IBM  360/370/4341/4381 

*) 

(* 

*) 

<* 

^EXECUTION  PROCEDURE 

• 

• 

*) 

(* 

NAME/VALUE  INTERFACE 

*) 

(* 

CALLED  FROM  THE  NAME/VALUE  INTERFACE 

*) 

(* 

*> 
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(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


^PROCESSING  DESCRIPTION:  *) 

OBTAIN  ENTITY  NAME  AND  KIND  FROM  SCHEMA  MODEL  *) 

STORE  ENTITY  NAME  AND  KIND  INTO  RUN-TIME  SUBSCHEMA  *) 

LOOP  THROUGH  SCHEMA  MODEL  ENTRIES  *) 

OBTAIN  ATTRIBUTE  ENTRY  FROM  SCHEMA  MODEL  *) 

CASE  DATA  TYPE  OF  *) 

INTEGER,  REAL,  STRING,  LOGICAL  *) 


:  APPLICATION_DATA_BLOCK_ATTRIBUTE,  PROCEDURE  (1)  *) 
POINTER  :  CONSTITUENT_LIST_ATTRIBUTE ,  PROCEDURE  (2)  *) 
ARRAY  :  ARRAY_ATTRIBUTE ,  PROCEDURE  (3)  *) 

BEFINEDJTYPE  :  DEFINED_TYPE_ATTRIBUTE ,  PROCEDURE  (4)  *) 
OTHERWISE  :  ERROR  MESSAGE  =  'UNKNOWN  ATTRIBUTE  TYPE’  *) 
ENDCASE  *) 

ENDLOOP  *) 


(*  PROCEDURE  (1)  :  APPLICATION_DATA_BLOCK_ATTRIBUTE  *) 

(*  STORE  ATTRIBUTE  DEFINITION  FOR  TYPE  IN  SCHEMA  MODEL  ENTRY  *) 

(*  *) 

(*  PROCEDURE  (2)  :  CONSTITUENT_LIST_ATTRIBUTE  *) 

(*  OBTAIN  CONSTITUENT  LIST  POSITION  FROM  SCHEMA  MODEL  *) 

(*  STORE  ATTRIBUTE  DEFINITION  FOR  TYPE  IN  SCHEMA  MODEL  ENTRY  *) 

(*  *) 

(*  PROCEDURE  (3)  :  ARRAY_ATTRIBUTE  *) 

(*  DETERMINE  THE  NUMBER  OF  ARRAY  DIMENSIONS  *) 

(*  STORE  ARRAY  INFORMATION  INTO  RUN-TIME  SUBSCHEMA  *) 

(*  STORE  TABLE  INDEX  POSITION  FOR  ARRAY  LIST  TABLE  AND  THE  *) 

(*  NUMBER  OF  DIMENSIONS  INTO  ARRAY  INDEX  TABLE  *) 

(*  CALCULATE  TOTAL  SIZE  OF  THE  ARRAY  AND  STORE  INTO  ARRAY  *) 

(*  INDEX  TABLE  *) 

(*  FOR  THE  NUMBER  OF  ARRAY  DIMENSIONS  *) 

(*  CALCULATE  THE  SIZE  OF  EACH  ARRAY  *) 

(*  STORE  SIZE  AND  LOW-BOUND  INTO  ARRAY  LIST  TABLE  *) 

(*  END  LOOP  *) 

(*  *) 

(*  PROCEDURE  (4)  :  DEFINED_TYPE_ATTRIBUTE  *) 

(*  OBTAIN  DATA  TYPE  FOR  DEFINED  TYPE  ATTRIBUTE  IN  SCHEMA  MODEL  *) 

(*  CASE  DATA_TYPE  OF  *) 

(*  INTlGER,  REAL,  STRING,  LOGICAL  *) 

(*  :  APPLIGATION_DATA_BLOCK_ATTRIBUTE,  PROCEDURE  (1)  *) 

(*  ENUMERATION  :  ENUMERATION_ATTRIBUTE ,  PROCEDURE  (5)  *) 

(*  POINTER  :  C0NSTITUENT_LIST_ATTR1BUTE,  PROCEDURE  (2)  *) 

(*  ARRAY  :  ARRAY_ATTRIBUTE ,  PROCEDURE  (3)  *) 

(*  OTHERWISE  :  ERROR  MESSAGE  =  ’UNKNOWN  ATTRIBUTE  TYPE'  *) 

(*  ENDCASE  *) 

(*  *) 
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(*  PROCEDURE  (5)  :  ENUMERATION_ATTRIBUTE  *) 
(*  STORE  ATTRIBUTE  DEFINITION  FOR  ENUMERATION  TYPE  *) 
(*  OBTAIN  NUMBER  OF  ENUMERATION  VALUES  FROM  SCHEMA  MODEL  *) 
(*  STORE  NUMBER  OF  ENUMERATION  VALUE  IN  ENUMERATION  INDEX  TABLE*) 
(*  STORE  ENUMERATION  VALUE  TABLE  INDEX  POSITION  IN  ENUMERATION  *) 
(*  INDEX  TABLE  *) 
(*  LOOP  THROUGH  ENUMERATION  VALUES  *) 
(*  OBTAIN  ENUMERATION  VALUE  FROM  SCHEMA  MODEL  *) 
(*  STORE  ENUMERATION  VALUE  IN  ENUMERATION  VALUE  TABLE  *) 
(*  END  LOOP  *) 
(*  *) 
(*  $ COMMENTS:  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 
(*  REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION)  *) 
(*  ORIGINATED:  15  JANUARY  1988,  M.  H.  CHOI,  DBMA  *) 
(*  *) 
(*  END  ^INCLUDE  RSTRSTC  ***********************************************) 
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(*  BEGIN  %INCLUDE  RS1100 
(* 

PROCEDURE  RS1100  (  CONST  SUBSCHEMAJCEY 

VAR  RUN_TIME 
VAR  RUN_TIME_SIZE 
VAR  IRC 
SUBPROGRAM; 


(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


**********************************************) 

*) 

:  ENTKEY; 

:  TJRUNTIME; 

:  INTEGER; 

:  RET_REC  ); 


^FUNCTION: 

STORE  ARRAY_ENTITY(1100)  IN  THE 
THE  RUN-TIME  SUBSCHEMA 

^DESCRIPTION  OF  ARGUMENTS: 


DATA  DICTIONARY  AND 


NAME 


RUN  TIME 


I/O  DESCRIPTION 


RUN  TIME  SIZE 


IRC 


RUN-TIME  SUBSCHEMA  WHICH  CONTAINS 
THE  ENTITY  DEFINITION,  ALONG  WITH 
ANY  ENUMERATION  VALUES,  CONSTITUENT 
LIST,  AND  ARRAY  INFORMATION,  IN  A 
COMPACTED  FORM. 

THE  NUMBER  OF  BYTES  ACTUALLY  REQUIRED*) 
FOR  THE  COMPACTED  RUN-TIME  SUBSCHEMA.*) 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 


RETURN  CODE 
«  0  SUCCESS 
>  0  CRITICAL  ERROR: 


^COMMONS : 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 
HARDWARE  SYSTEM:  IBM 


(SEGMENT  SUBPROGRAM) 
360/370/ 4341/4381 


^EXECUTION  PROCEDURE: 

NAME/VALUE  INTERFACE 

CALLED  FROM  THE  NAME/VALUE  INTERFACE 

^PROCESSING  DESCRIPTION: 

OBTAIN  ENTITY  NAME  AND  KIND  FROM  SCHEMA  MODEL 
STORE  ENTITY  NAME  AND  KIND  INTO  RUN-TIME  SUBSCHEMA 
STORE  GLOBAL  ATTRIBUTES 
STORE  CL_ENTITIES  ATTRIBUTE 

^COMMENTS : 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  $ CHANGE  CONTROL:  *) 
(*  REVISED:  (DATE,  NAME,  GROUP,  REASON/DESCRIPTION)  *) 
(*  ORIGINATED:  20  AUGUST  1987,  M.  H.  CHOI,  DBMA  *) 
(*  *) 


(*  END  %INCLUDE  RS1100  ************5 ************************************ ) 
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(*  %INCLUDE  SCALFSRT  *) 

(**) 

PROCEDURE  SCALFSRT (CONST  CURRENT  :  ENTBLOCK; 

CONST  NEXT  :  ENTBLOCK; 

VAR  FLIP  :  BOOLEAN; 

VAR  RRC  :  EXT_RET_CODE; 

VAR  PROC  :  ROUTINE); 

SUBPROGRAM; 

(**) 


(* - *) 

<*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  IS  THE  ORDER  FUNCTION  CALLED  BY  MALSRT  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS;  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  CURRENT  I  THE  ADB  OF  THE  CURRENT  ENTITY  *) 

(*  NEXT  I  THE  ADB  OF  THE  NEXT  ENTITY  *) 

(*  FLIP  0  INDICATES  IF  THE  ENTITIES  SHOULD  BE  *) 

(*  FLIPPED  *) 

(*  RRC  0  THE  ROUTINE’S  RETURN  CODE  *) 

(*  =  0  OK  *) 

(*  <>  0  ERROR  *) 

(*  XRC  0  EXTERNAL  RETURN  CODE  FROM  MAS  *) 

(*  =0  OK  *) 

(*  >=  10  ERROR  *) 

(*  *) 

(*  $  COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  IS  CALLED  BY  THE  MAS  ROUTINE  MALSRT.  THE  *) 

(*  TWO  ENTITIES  ARE  COMPARED  AND  IF  THEY  ARE  OUT  OF  ALPHA-  *) 

(*  BETICAL  ORDER  THE  FLIP  FLAG  IS  SET  TO  TRUE  OTHERWISE  THE  *) 

(*  FLAG  REMAINS  FALSE.  IF  THE  FLAG  IS  TRUE  THE  ENTITIES  ARE  *) 

(*  SWAPPED  OTHERWISE  THEY  ARE  NOT.  *) 

C*  *) 

(*  $ COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 
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(*  %INCLUDE  SCARYCR  *) 

(**) 

PROCEDURE  SCARYCR(VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANSPTR; 
VAR  CONTEXT  :  T_CONTEXT) ; 

SUBPROGRAM; 

(**) 


(* - - - - - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GATHERS  THE  DATA  NECESSARY  TO  CREATE  THE  *) 

(*  ARRAY  ENTITY  AND  PUSHES  THE  DATA  ON  THE  TRANSACTION  *) 

<*  STACK.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  THE  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  THE  TRANSACTION  STACK  *) 

(*  CONTEXT  I  THE  CONTEXT  IN  WHICH  THE  ARRAY  IS  BEING  *) 

(*  CREATED  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  REF  *) 

(*  INSIDE  I/O  INDICATES  IF  THE  EXIT  OR  RETURN  OPTION  *) 

(*  IS  CHOSEN  WITHIN  ANOTHER  ROUTINE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINE  CRARRAY  *) 

(*  TO  DISPLAY  THE  PANEL.  THE  DATA  ENTERED  ON  THE  PANEL  IS  *) 

(*  VERIFIED  AND  IF  IT  IS  OK  IT  IS  PUSHED  ON  THE  TRANSACTION  *) 

(*  STACK  OR  THE  APPROPRIATE  ACTION  IS  TAKEN.  IF  ANY  OF  THE  *) 

(*  DATA  ENTERED  IS  INVALID  THEN  THE  PANEL  IS  REDISPLAYED  *) 

<*  WITH  AN  ERROR  MESSAGE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

<*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  REVISED:  JANUARY  1988  C.  H.  MOHME  DBMA  *) 
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(*  MODIFIED  TO  INCORPORATE  THE  STRUCTURE  DATA  TYPE  *) 

(*  *) 

(*  REVISED:  10/09/87  C.  H.  MOHME  DBMA  *) 

(*  ADDED  PARAMETER  TO  SCDEFCR  CALL.  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  ADDED  LIST  AND  SET.  NOTE:  THE  LIST  AND  SET  DATA  TYPES  ARE  *) 

(*  IMPLEMENTED  IN  THE  SOFTWARE  AS  AN  ARRAY.  A  FIELD  WAS  ADDED  *) 

(*  TO  THE  ARRAY  ADB  TO  SPECIFY  WHETHER  THE  ARRAY  IS  A  CONCEPTUAL  *) 

(*  ARRAY,  LIST,  OR  SET.  *) 

(*  *) 

(*  ORIGINATED:  04/22/86  L.  J.  BEHAN  FRMI  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  SCARYCR  *) 
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(*  %INCLUDE  SCARYUP  *) 

(**) 

PROCEDURE  SCARYUP (VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  ARRAY_KEY  :  ENTKEY ; 

VAR  NUMBER_OF_USERS  :  LISTKEY; 

VAR  DELETE_LIST  :  LISTKEY; 

VAR  NEW_KEYS_LIST  :  LISTKEY; 

VAR  CONTEXT  ♦  T_CONTEXT ) ; 

SUBPROGRAM; 

(**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  GATHERS  THE  DATA  TO  UPDATE  AN  ARRAY. 

<* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 

(*  NAME  I/O  DESCRIPTION 

(*  IRC  0  RETURN  CODE 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK 

(*  ARRAY_KEY  I/O  KEY  OF  THE  ARRAY  TO  BE  UPDATED 

(*  NUMBER_OF_USERS  I/O  THE  NUMBER  OF  USERS  OF  THE  ARRAY 

(*  DELETEJLIST  I/O  LIST  OF  ENTITIES  TO  BE  DELETED 

(*  NEW_KEYS_LIST  I/O  LIST  OF  NEWLY  CREATED  ENTITIES 

(*  CONTEXT  I  THE  CONTEXT  IN  WHICH  THE  ARRAY  IS  BEING 

(*  UPDATED 

(* 

(*  ^COMMONS: 

(*  NONE 

<* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(*  THE  CURRENT  ARRAY  DATA  IS  DISPLAYED  ON  THE  UPARRAY  PANEL. 

(*  THE  DATA  CAN  THEN  BE  UPDATED  BY  THE  USER. 

(* 

(*  $  COMMENTS: 

<* 

(*  $ CHANGE  CONTROL: 

(* 


*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  SCBASIN  *) 

(**) 

PROCEDURE  SCBASIN(VAR  IRC  :  RET_REC ; 

VAR  INCLD  :  TEXT; 

VAR  ENTITYJCEY  :  ENTKEY; 

VAR  ADB  :  ENTITY_ADB) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  WRITES  THE  ENTITY  KIND  CONSTANTS  TO  THE  *) 

(*  PASCAL  INCLUDE  FILE.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  I/O  RETURN  CODE  *) 

(*  INCLD  I  THE  FILE  NAME  *) 

(*  ENTITYJCEY  I  THE  ENTITY  KEY  *) 

(*  ADB  0  THE  ENTITY  ADB  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  GET  THE  ADB  OF  THE  PRIMITIVE  ENTITY  *) 

(*  CASE  PRIMITIVE  ENTITY  KIND  OF  *) 

(*  INTEGER  :  *) 

(*  CASE  PRECISION  IN  DECIMAL  DIGITS  OF  *) 

(*  1,  2  :  WRITE  TO  THE  FILE  PACKED  0. .255;  *) 

(*  3,  4  :  WRITE  TO  THE  FILE  PACKED  0.. 65535;  *) 

(*  5,  6,  7,  *) 

(*  8,  9  :  WRITE  TO  THE  FILE  INTEGER;  *) 

(*  END;  *) 

(*  REAL  :  *) 

(*  CASE  PRECISION  IN  DECIMAL  DIGITS  OF  *) 

(*  1,  2,  3,  4,  *) 

(*  5,  6,  7  :  WRITE  TO  THE  FILE  SHORTREAL;  *) 

(*  8,  9,  10,  *) 
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(* 

11,  12,  13, 

*) 

(* 

14,  15,  16  :  WRITE  TO  THE  FILE  REAL; 

*) 

(* 

END; 

*) 

(* 

STRING  : 

*) 

(* 

WRITE  TO  THE  FILE  PACKED  ARRAY( .1. . <STRING  LENGTH > . ) 

*) 

(* 

OF  CHAR; 

*) 

(* 

DEFINED  TYPE  : 

*) 

(* 

WRITE  TO  THE  FILE  T_<DEFINED  TYPE  NAME>; 

*) 

(* 

LOGICAL  : 

*) 

(* 

WRITE  TO  THE  FILE  BOOLEAN; 

*) 

(* 

ENUMERATION  : 

*) 

(* 

WRITE  TO  THE  FILE  ( 

*) 

(* 

SET  THE  ENUMERATION'S  CONSTITUENT  LIST  TO  READ  FORWARD 

*) 

(* 

COUNT  THE  NUMBER  OF  CONSTITUENTS 

*) 

(* 

FOR  INDEX  EQUALS  ONE  TO  THE  NUMBER  OF  CONSTITUENTS  DO 

*) 

(* 

GET  THE  KEY  TO  THE  NEXT  CONSTITUENT  IN  THE  LIST 

*) 

(* 

GET  THE  CONSTITUENT'S  ADB 

*) 

(* 

WRITE  TO  THE  FILE  <ENUMERITEM  NAME> 

*) 

(* 

IF  THE  COUNT  IS  EQUAL  TO  THE  NUMBER  OF  CONSTITUENTS 

*) 

(* 

WRITE  TO  THE  FILE  ); 

*) 

(* 

ELSE 

*) 

(* 

WRITE  TO  THE  FILE  , 

*) 

(* 

END; 

*) 

(* 

ARRAY  : 

*) 

1  (* 

GET  THE  ADB  OF  THE  ARRAY  ENTITY 

*) 

(* 

WRITE  TO  THE  FILE  ARRAY( . <LOW  BOUND> . . <HIGH  BOUND>.)  OF 

*) 

(* 

SET  THE  ARRAY  ENTITY'S  CONSTITUENT  LIST  TO  READ  FORWARD 

*) 

(* 

GET  THE  KEY  TO  THE  ARRAY  ENTITY’S  FIRST  CONSTITUENT 

*) 

(* 

GET  THE  CONSTITUENT'S  ADB 

*) 

(* 

CALL  THIS  ROUTINE  TO  WRITE  OUT  THE  ARRAY'S  TYPE 

*> 

(* 

INTEGER 

*) 

(* 

REAL 

*) 

(* 

STRING 

*) 

(* 

LOGICAL 

*) 

(* 

ARRAY 

*) 

(* 

DEFINED  TYPE 

*) 

(* 

POINTER 

*) 

(* 

END; 

*) 

(* 

STRUCTURE  : 

*) 

(* 

WRITE  TO  THE  FILE  RECORD 

*) 

(* 

SET  THE  STRUCTURE'S  CONSTITUENT  LIST  TO  BE  READ  FORWARD 

*) 

(* 

CONTINUE  TO  READ  CONSTITUENTS  UNTIL  THE  END  OF  LIST 

*) 

(* 

GET  THE  KEY  TO  THE  NEXT  CONSTITUENT  ENTITY  ON  THE  LIST 

*) 

(* 

GET  THE  CONSTITUENT’S  ADB 

*) 

WRITE  TO  THE  FILE  <FIELD  NAME>  : 

*) 

1  (* 

GET  THE  KEY  TC  THE  CONSTITUENT’S  FIRST  CONSTITUENT 

*) 

(* 

GET  THIS  CONSTITUENT'S  ADB 

*) 

1 

1 
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CALL  THIS  ROUTINE  TO  WRITE  OUT  THE  PRIMITIVE  TYPE  *) 

INTEGER  *) 

REAL  *) 

STRING  *) 

LOGICAL  *) 

ARRAY  *) 

DEFINED  TYPE  *) 

POINTER  (IS  NOT  ALLOWED  WITHIN  A  STRUCTURE)  *) 

IF  THE  END  OF  LIST  IS  FOUND  THEN  *) 

WRITE  TO  THE  FILE  END;  *) 

END;  *) 

END;  *) 

*) 

$ COMMENTS:  *) 

*) 

$ CHANGE  CONTROL:  *) 

*) 
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(*  %1NCLUDE  SCCHRCK  *) 

(**) 

PROCEDURE  SCCHRCK(VAR  IRC  :  R£T_REC; 

VAR  NAME  :  T_NAKE; 

VAR  INVALID  :  BOOLEAN); 

SUBPROGRAM; 

(**) 


(* - *) 

C*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  CHECKS  THAT  THE  CHARACTERS  IN  AN  ENTITY  NAME  ARE  VALID  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  I/O  RETURN  CODE  *) 

(*  NAME  I  NAME  TO  CHECK  FOR  VALID  CHARACTERS  *) 

(*  INVALID  0  INDICATES  IF  THE  NAME  CONTAINS  AN  IN-  *) 

(*  VALID  CHARACTER  OR  A  SPACE  INBETWEEN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  RONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 


(*  ^PROCESSING  DESCRIPTION:  *) 
(*  THIS  ROUTINE  CHECKS  THAT  THE  NAME  CONTAINS  VALID  CHARAC-  *) 
(*  TERS.  VALID  CHARACTERS  ARE  THE  LETTERS  A  THRU  Z,  THE  *) 
(*  DIGITS  0  THRU  9,  BLANKS  AND  UNDERSCORES  ARE  ALLOWED.  ANY  *) 
(*  OTHER  CHARACTERS  ARE  INVALID.  THE  NAME  IS  ALSO  CHECKED  *) 
(*  FOR  SPACES  INBETWEEN  CHARACTERS.  THIS  TOO  IS  INVALID.  *) 


(*  *) 

(*  ^COMMENTS:  *) 

(*  *  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *> 
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(*  %INCLUDF.  SCCLSCR1  *) 

(**) 

PROCEDURE  SCCLSCR1(VAR  IRC  :  RETJREC; 

VAR  TRANS_STACK  :  TRANSPTR) ; 

SUBPROGRAM; 


(* - 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GATHERS  THE  NAME  AND  KIND  NUMBER  TO  BE  *) 

(*  ASSIGNED  TO  THE  CLASS  ENTITY  TO  BE  CREATED.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  REF  *) 

(*  INSIDE  I/O  INDICATES  IF  THE  EXIT  OPTION  OR  RETURN  *) 

(*  HAS  BEEN  CHOSEN  WITHIN  ANOTHER  CREATE  *) 

(*  PROCEDURE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

<*  THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINE  (CRCLASS1)  *) 

(*  WHICH  PUTS  UP  THE  MENU  TO  GATHER  THE  NAME  AND  KIND  NUMBER  *) 

(*  FOR  THE  CLASS  ENTITY.  THE  DATA  IS  VERIFIED  FOR  UNIQUENESS.  *) 

(*  IF  THE  INFORMATION  ENTERED  IS  INDEED  UNIQUE  THEN  IT  IS  *) 

(*  PUSHED  ONTO  THE  TRANSACTION  STACK.  THEN  (SCCLSCR2)  IS  *) 

(*  CALLED  TO  GATHER  THE  CONSTITUENTS.  WHEN  ALL  THE  REQUIRED  *) 

(*  DATA  HAS  BEEN  ENTERED  TO  CREATE  A  CLASS  ENTITY  THE  *) 

(*  TRANSACTION  PROCESSOR  ROUTINE  (SCIRSPR)  IS  CALLED  TO  *) 

(*  PROCESS  THE  TRANSACTIONS.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

<*  *) 
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(*  %INCLUDE  SCCLSCR2  *) 

(**) 

PROCEDURE  SCCLSCR2(VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANSPXR); 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GATHERS  THE  CONSTITUENTS  OF  THE  CLASS  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  REF  *) 

(*  INSIDE  I/O  INDICATES  IF  THE  EXIT  OPTION  OR  RETURN  *) 

(*  HAS  BEEN  CHOSEN  WITHIN  ANOTHER  CREATE  *) 

(*  PROCEDURE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  $ EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINE  (CRCLASS2)  *) 

(*  WHICH  PUTS  UP  THE  MENU  TO  GATHER  THE  CONSTITUENTS .  THE  *) 

(*  CONSTITUENTS  ARE  PUSHED  ON  THE  STACK  AFTER  VERIFYING  THAT  *) 

(*  THEY  DO  EXIST.  *) 

(*  *) 

(*  $ COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  SCCLSUP  *) 

(**) 

PROCEDURE  SCCLSUP(VAR  IRC  :  RET_REC; 

VAR  CLASS_KEY  :  ENTKEY) ; 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  ^FUNCTION:  *) 

(*  THIS  ROUTINE  GATHERS  THE  DATA  TO  UPDATE  THE  CLASS  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  CLASS_KEY  I  KEY  OF  THE  ENTITY  TO  BE  UPDATED  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINES  WHICH  *) 

(*  DISPLAY  THE  DATA  DESCRIBING  THE  CLASS  ENTITY.  THE  UPDATE  *) 

(*  CLASS  OPTIONS  INCLUDE  :  CHANGE  THE  NAME  AND/OR  KIND  NUMBER,  *) 

(*  UPDATE  THE  CONSTITUENT  LIST  BY  *) 

(*  ADDING  OR  REMOVING  ELEMENTS,  *) 

(*  REVIEW  A  CONSTITUENT,  *) 

(*  DELETE  THE  CLASS  ENTITY,  *) 

(*  SAVE  THE  CHANGES,  *) 

(*  RETURN  AND  EXIT.  *) 

(*  THE  CHANGES  MADE  TO  THE  CLASS  ENTITY  ARE  KEPT  ONLY  IF  THE  *) 

(*  OPTION  SAVE  THE  CHANGES  IS  SELECTED.  OTHERWISE  ANY  CHANGES  *) 

(*  MADE  ARE  IGNORED.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  SCCOMPAR  *) 

(**) 

PROCEDURE  SCCOMPAR (VAR  FIRST_NAME  :  T_NAME; 

VAR  SECOND_NAME  :  T_NAME; 
VAR  DIFFERENT  :  BOOLEAN); 

SUBPROGRAM; 

■(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  COMPARES  TWO  NAMES  FOR  THE  LENGTH  SPECIFIED  *) 

(*  BY  'UNIQUENESS_LENGTH '  IN  SCECON.  THE  VARIABLE  ’DIFFERENT’  *) 

(*  IS  SET  TO  TRUE  IF  THE  TWO  NAMES  DIFFER.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  FIRST_NAME  I  THE  FIRST  NAME  *) 

(*  SECOND_NAME  I  THE  SECOND  NAME  *) 

(*  DIFFERENT  0  SET  TO  TRUE  IF  THE  TWO  NAMES  DIFFER  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  INITIALIZE  VARIABLES  *) 

(*  COMPARE  FIRST_NAME  TO  SECOND_NAME  CHARACTER-BY-CHARACTER  *) 

(*  UNTIL  LENGTH  IS  SURPASSED  OR  A  DIFFERENCE  IS  DETECTED.  *) 

(*  *) 

(*  $ COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  SCCONIN  *) 

(**) 

PROCEDURE  SCCONIN(VAR  IRC  :  RET_REC ; 

VAR  INCLD  :  TEXT; 

VAR  ENTITY_LIST  :  LISTKEY); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  WRITES  THE  ENTITY  KIND  CONSTANTS  TO  THE  *) 

(*  PASCAL  INCLUDE  FILE.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  I/O  RETURN  CODE  *) 

(*  INCLD  I  THE  FILE  NAME  *) 

(*  ENTITY_LIST  I  A  LIST  OF  ENTITIES  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  WRITE  THE  ENTITY  CONSTANT  HEADING  TO  THE  FILE  *) 

(*  WRITE  'CONST'  TO  THE  FILE  *) 

(*  SET  THE  LIST  OF  ENTITIES  TO  BE  READ  FORWARD  *) 

<*  CONTINUE  TO  READ  THE  ENTITIES  UNTIL  THE  END  OF  THE  LIST  *) 

(*  GET  THE  KEY  TO  THE  NEXT  ENTITY  IN  THE  LIST  *) 

(*  GET  THIS  ENTITY'S  ADB  *) 

(*  IF  THE  ENTITY  KIND  IS  AN  ENTITY  THEN  *) 

(*  WRITE  TO  THE  FIELD  K_ < ADB .ENT. NAME >  =  <ADB.ENT.KIND>  ;  *) 

(*  END;  *) 

C*  *) 

(*  ^COMMENTS:  *) 

<*  *> 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  SGCREATE  *) 

(**) 

PROCEDURE  SCCREATE(VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANSPTR) ; 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  DETERMINES  THE  NEXT  MENU  TO  DISPLAY  FROM  THE  *) 

(*  CREATE  OPTION  CHOSEN.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  TRANSJ3TACK  I/O  POINTS  TO  THE  TRANSACTION  STACK  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  DEF  *) 

(*  INSIDE  I/O  INDICATES  IF  THE  EXIT  OPTION  HAS  *) 

(*  BEEN  CHOSEN  WITHIN  ANOTHER  CREATE  *) 

(*  PROCEDURE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  CALLS  THE  CREATE  MENU  INTERFACE  ROUTINE  (MCREATE)  AND  *) 

(*  PROCESSES  THE  DATA  RECIEVED  FROM  THE  MENU  EITHER  BY  *) 

(*  CALLING  THE  APPROPRIATE  ROUTINE  OR  EXITING  THE  PROCEDURE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  >  ^CHANGE  CONTROL:  *) 

(*  '  *) 
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(*  %INCLUDE  SCDEFCR  *) 

(**) 

PROCEDURE  SCDEFCR(VAR  IRC  :  RET_REC; 

VAR  T_TYP  :  TRANS_TYPE ; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  CONTEXT  :  T_C0NTEXT) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GATHERS  THE  DATA  NECESSARY  TO  CREATE  THE  *) 

(*  DEFINED  TYPE  ENTITY  AND  PUSHES  THE  DATA  ON  THE  TRANS-  *) 

(*  ACTION  STACK.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  THE  RETURN  CODE  *) 

(*  T_TYP  I  THE  TYPE  OF  TRANSACTION  (EITHER  CREATING  *) 

(*  A  STAND-ALONE  DEFINED  TYPE  OR  A  DEFINED  *) 

(*  TYPE  WITHIN  AN  ENTITY) .  *) 

(*  TRANS_STACK  I/O  THE  TRANSACTION  STACK  *) 

(*  CONTEXT  I  THE  CONTEXT  IN  WHICH  THE  DEFINED  TYPE  *) 

(*  IS  BEING  CREATED  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  REF  *) 

(*  INSIDE  I/O  INDICATES  IF  THE  EXIT  OR  RETURN  OPTION  *) 

(*  IS  CHOSEN  WITHIN  ANOTHER  ROUTINE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINE  CRDEFTYP  *) 

(*  TO  DISPLAY  THE  PANEL.  THE  DATA  ENTERED  ON  THE  PANEL  IS  *) 

(*  VERIFIED  AND  IF  IT  IS  OK  IT  IS  PUSHED  ON  THE  TRANSACTION  *) 

(*  STACK  OR  THE  APPROPRIATE  ACTION  IS  TAKEN.  IF  ANY  OF  THE  *) 

(*  DATA  ENTERED  IS  INVALID  THEN  THE  PANEL  IS  REDISPLAYED  *) 

(*  WITH  AN  ERROR  MESSAGE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 
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(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  REVISED:  JANUARY  1988  C.  H.  MOHME  DBMA  *) 

(*  MODIFIED  TO  INCORPORATE  THE  STRUCTURE  DATA  TYPE  *) 

(*  *) 

(*  REVISED:  10/09/87  C.  H.  MOHME  DBMA  *) 

(*  ADDED  PARAMETER  TO  ALLOW  FOR  THE  CREATION  OF  A  DEFINED  TYPE  *) 

(*  FROM  THE  MAIN  CREATE  MENU.  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  ADDED  LIST  AND  SET.  NOTE:  THE  LIST  AND  SET  DATA  TYPES  ARE  *) 

(*  IMPLEMENTED  IN  THE  SOFTWARE  AS  AN  ARRAY.  A  FIELD  WAS  ADDED  *) 

(*  TO  THE  ARRAY  ADB  TO  SPECIFY  WHETHER  THE  ARRAY  IS  A  CONCEPTUAL  *) 

(*  ARRAY,  LIST,  OR  SET.  *) 

(*  *> 

(*  ORIGINATED:  04/22/86  L.  J.  BEHAN  FRMI  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  /.INCLUDE  SCDEFCR  *) 
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(*  %INCLUDE  SCDEFUP  *) 

(**) 

PROCEDURE  SCDEFUP(VAR  IRC 

VAR  TRANS_STACK 
VAR  DEFINED_TYPE_KEY 
VAR  NUMBER_OF_USERS 
VAR  DELETE_LIST 
VAR  NEW_KEYS_LIST 
VAR  CONTEXT 


SUBPROGRAM; 

(**) 


RET_REC; 

TRANSPTR; 

ENTKEY; 

INTEGER; 

LISTKEY; 

LISTKEY; 

T_CONTEXT) ; 


(* - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  GATHERS  THE  DATA  TO  UPDATE  THE  DEFINED  TYPE 

(*  ENTITY. 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 


(* 

NAME 

I/O 

DESCRIPTION 

(* 

===== 

===== 

n 

ii 

n 

ii 

ii 

ii 

ii 

ii 

ii 

ii 

ii 

(* 

DEFINED_TYPE_KEY 

I/O 

KEY  OF  THE  ENTITY  TO  BE  UPDATED 

(* 

DELETE_LIST 

I/O 

LIST  OF  ENTITIES  TO  BE  DELETED 

(* 

(* 

NEW_KEYS_LIST 

I/O 

LIST  OF  ENTITIES  TO  BE  DELETED  IF 

THE  CHANGES  MADE  ARE  REJECTED 

(* 

NUMBER_OF_USERS 

I 

INDICATES  THE  NUMBER  OF  USERS 

(* 

TRANS_STACK 

I/O 

POINTS  TO  THE  TRANSACTION  STACK 

(* 

IRC 

0 

RETURN  CODE 

(* 

CONTEXT 

I 

THE  CONTEXT  IN  WHICH  THE  DEFINED  TYPE 

(*  IS  BEING  UPDATED 

(* 

(*  ^COMMONS: 

(*  NONE 

(* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

<* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 

<* 

(*  ^PROCESSING  DESCRIPTION: 

(*  THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINE  (UPDEFTYP) 

(*  TO  DISPLAY  THE  INFORMATION  ABOUT  THE  DEFINED  TYPE  ENTITY. 

(*  THE  USER  CAN  CHANGE  THE  NAME  OR  TYPE  OF  THE  ENTITY  OR 

(*  SELECT  ONE  OF  THE  FOLLOWING  OPTIONS  ON  THE  PANEL  : 

(*  REVIEW  THE  CURRENT  TYPE, 

(*  UPDATE  THE  CURRENT  TYPE, 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  SAVE  THE  CHANGES  MADE,  *) 
(*  RETURN  OR  EXIT.  *) 
(*  IF  SAVE  THE  CHANGES  IS  SELECTED  AND  THE  NUMBER  OF  USERS  OF  *) 
(*  THE  DEFINED  TYPE  IS  ONE  THEN  THE  OLD  DEFINED  TYPE  KEY  IS  *) 
(*  PLACED  ON  THE  DELETE  LIST  AND  A  NEW  DEFINED  TYPE  ENTITY  IS  *) 
(*  CREATED.  THE  NEW  DEFINED  TYPE  KEY  IS  THEN  PLACED  ON  THE  *) 
(*  NEW  KEYS  LIST.  IF  SAVE  THE  CHANGES  IS  SELECTED  AND  THE  *) 
(*  NUMBER  OF  USERS  OF  THE  DEFINED  TYPE  IS  GREATER  THAN  ONE  *) 
(*  THEN  THE  DEFINED  TYPE  ENTITY  IS  UPDATED.  *) 
(*  *) 
(*  ^COMMENTS:  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 
(*  *) 
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(*  %INCLUDE  SCENMUP  *) 

(**) 

PROCEDURE  SCENMUP(VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  ENUMJCEY  :  ENTKEY; 

VAR  DELETE_LIST  :  LISTKEY; 

VAR  NEW_KEYS_LIST  :  LISTKEY); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GATHERS  THE  DATA  TO  UPDATE  THE  ENUMERATION  *) 

(*  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  TRANS.STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK  *) 

(*  ENUM_KEY  I/O  KEY  OF  THE  ENTITY  TO  BE  UPDATED  *) 

(*  DELETE_LIST  I/O  LIST  OF  ENTITIES  TO  BE  DELETED  *) 

(*  NEW_KEYS_LIST  T/O  LIST  OF  NEWLY  CREATED  ENTITIES  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINE  (UPENUM)  *) 

(*  TO  DISPLAY  DATA  ABOUT  THE  ENUMERATION  ENTITY.  *) 

(*  THE  UPDATE  OPTIONS  INCLUDE  THE  FOLLOWING  :  *) 

(*  ADD  AN  ITEM  TO  THE  ENUMERATION,  *) 

(*  REMOVE  AN  ITEM  FROM  THE  ENUMERATION,  *) 

(*  SAVE  THE  CHANGES  MADE,  *) 

(*  RETURN  AND  EXIT.  *) 

(*  THE  CHANGES  MADE  TO  THE  ENUMERATION  ARE  KEPT  ONLY  IF  THE  *) 

(*  OPTION  SAVE  THE  CHANGES  IS  SELECTED,  OTHERWISE  ANY  CHANGES  *) 

(*  THAT  WERE  MADE  ARE  IGNORED.  *) 

(*  *) 
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(*  $, COMMENTS: 

(* 

(*  $ CHANGE  CONTROL: 

(* 
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(*  %INCLUDE  SCENTCR  *) 

<**) 

PROCEDURE  SCENTCR(VAR  IRC  :  RET_REC ; 

VAR  TRANS_STACK  :  TRANSPTR) ; 

SUBPROGRAM; 

(**) 


<* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GATHERS  THE  DATA  NECESSARY  TO  MODEL  THE  *) 

(*  ENTITY  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  REF  *) 

(*  INSIDE  I/O  INDICATES  IF  THE  EXIT  OR  RETURN  OPTION  *) 

(*  IS  CHOSEN  WITHIN  ANOTHER  ROUTINE.  *) 

(*  *) 

(*  .^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINE  (CRENTITY)  *) 

(*  WHICH  DISPLAYS  THE  CREATE  ENTITY  PANEL.  THE  NAME  AND  *) 

(*  KIND  NUMBER  IS  CHECKED  FOR  UNIQUENESS.  IF  THEY  ARE  UNIQUE  *) 

(*  THEN  THE  DATA  IS  PUSHED  ONTO  THE  TRANSACTION  STACK  AND  *) 

(*  THE  ROUTINE  (SCFLDCR)  IS  CALLED  TO  ENTER  THE  ENTITY'S  *) 

(*  FIELDS.  AFTER  ALL  OF  THE  FIELDS  HAVE  BEEN  ENTERED  THE  *) 

(*  TRANSACTION  PROCESSING  ROUTINE  IS  CALLED  TO  MODEL  THE  *) 

(*  ENTITY.  *) 

(*  *> 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  ^INCLUDE  SCENTIN  *) 

(**) 

PROCEDURE  SCENTIN (VAR  IRC  :  RET_REC; 

VAR  INCLD  :  TEXT; 

VAR  ENTITY_LIST  :  LISTKEY; 

VAR  ADB_DEFN  :  LISTKEY; 

VAR  CLJDEFN  :  LISTKEY); 

SUBPROGRAM; 

(**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  WRITES  THE  ENTITY  TYPE  DECLARATIONS  TO  THE 

(*  PASCAL  INCLUDE  FILE. 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 

(*  NAME  I/O  DESCRIPTION 

(*  IRC  I/O  RETURN  CODE 

(*  INCLD  I  THE  FILE  NAME 

(*  ENTITY_LIST  I  A  LIST  OF  ENTITIES 

(*  APB_DEFN  0  A  LIST  OF  ENTITIES  ADB  DEFINITIONS  WERE 

(*  GENERATED  FOR 

(*  CL_DEFN  0  A  LIST  OF  ENTITIES  CONSTITUENT  DEFINI- 

(*  TIONS  WERE  GENERATED  FOR 

(* 

(*  $ COMMONS: 

(*  NONE 

(* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 

<* 

(*  ^PROCESSING  DESCRIPTION: 

(*  WRITE  TO  THE  FILE  THE  ENTITY  DECLARATIONS  HEADING 

(*  WRITE  TYPE  TO  THE  FILE 

(*  SET  THE  LIST  OF  ENTITIES  TO  BE  READ  FORWARD 

(*  CONTINUE  TO  READ  ENTITIES  UNTIL  THE  END  OF  LIST  IS  FOUND 

(*  GET  THE  KEY  TO  THE  NEXT  ENTITY  ON  THE  LIST 

(*  GET  THE  ENTITY’S  ADB 

(*  CALL  THE  PROCEDURE  TO  SORT  THE  FIELDS 

(*  COUNT  THE  NUMBER  OF  ITEMS  IN  THE  LIST  OF  ADB  FIELDS 

(*  IF  THE  NUMBER  OF  ITEMS  ON  THE  LIST  IS  GREATER  THAN  0  THEN 

(*  WRITE  TO  THE  FILE  E_<ENTITY  NAME>  =  RECORD 


■*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*/ 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 


3-489 


Cl  PS560240032U 
April  1990 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

f* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 


CALL  THE  FIELD  INCLUDE  PROCEDURE  *) 

WRITE  TO  THE  FILE  END;  *) 

ADD  THE  ENTITY  KEY  TO  THE  LIST  OF  ENTITY  ADB  DEFINITIONS*) 
COUNT  THE  NUMBER  OF  ITEMS  ON  THE  CONSTITUENT  FIELD  LIST  *) 
IF  THE  NUMBER  OF  ITEMS  ON  THE  LIST  IS  GREATER  THAN  0  THEN  *) 
WRITE  TO  THE  FILE  C_<ENTITY  NAME>  =  RECORD  *) 

CALL  THE  FIELD  INCLUDE  PROCEDURE  *) 

WRITE  TO  THE  FILE  END;  *) 

WRITE  TO  THE  FILE  P_T_<ENTITY  NAME>  =  RECORD  *) 

CALL  THE  FIELD  INCLUDE  PROCEDURE  *) 

WRITE  TO  THE  FILE  END;  *) 

WRITE  TO  THE  FILE  CONST  *) 

WRITE  TO  THE  FILE  P_<ENTITY  NAME>  =  P_T_<ENTITY  NAME>(  *) 

FOR  INDEX  EQUALS  ONE  TO  NUMBER  OF  CONSTITUENT  FIELDS  DO  *) 
WRITE  TO  THE  FILE  INDEX  *) 

IF  INDEX  EQUALS  THE  NUMBER  OF  CONSTITUENT  FIELDS  THEN  *) 
WRITE  TO  THE  FILE  );  *) 

ELSE  *) 

WRITE  TO  THE  FILE  ,  *) 

ADD  THE  KEY  TO  THE  LIST  OF  GENERATED  CONSTITUENT  *) 

DEFINITIONS  *) 

END;  *) 

^COMMENTS:  *j 

$ CHANGE  CONTROL:  *) 

*) 

REVISED:  09/28/87  C.  H.  MOHME  DBMA  *) 

INCORPORATED  THE  SUPERTYPE  DATA  TYPE.  *) 

*) 

REVISED:  08/04/87  C.  H.  MOHME  DBMA  *) 

CHANGED  NAMING  CONVENTION  FROM  C_T_  TO  S_  FOR  THE  TYPE  DE-  *) 
CLARATION  FOR  A  STRUCTURED  CONSTANT  FOR  CONSTITUENT  LIST  *) 

POSITIONS  (IBM  SPECIFIC).  *) 

*) 

REVISED:  07/30/87  C.  H.  MOHME  DBMA  *) 

CHANGED  NAMING  CONVENTION  FROM  P_  TO  C_  FOR  THE  CONSTANT  FOR  *) 
CONSTITUENT  LIST  POSITION  AND  C_  TO  P_  FOR  ENTITY  TYPE  *) 

DECLARATIONS  FOR  THE  CONSTITUENT  REFERENCED  RY  THE  CONSTI-  *) 

TUENT  KEY.  *\ 


*) 

REVISED:  07/30/87  C.  H.  MOHME  DBMA  *) 
CHANGED  NAMING  CONVENTION  FROM  P_T_  TO  C_T_  FOR  THE  ENTITY  *) 
TYPE  DECLARATION  FOR  THE  CONSTITUENT  REFERENCED  BY  THE  CON-  *) 
STITUENT  LIST  POSITION.  *\ 


REVISED:  07/22/87  C.  H.  MOHME 


*) 

DBMA  *) 
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(*  CHANGED  NAMING  CONVENTION  FROM  C_  TO  K_  FOR  ENTITY  KIND  *) 

(*  CONSTANTS  AND  FROM  K_  TO  C_  FOR  ENTITY  TYPE  DECLARATIONS  *) 

(*  FOR  THE  CONSTITUENTS  REFERENCED  BY  THE  CONSTITUENT  KEY.  *) 

(*  *) 

(*  ORIGINATED:  10/23/86  L.  J.  BEHAN  DBMA  *) 

(*  *) 

<* - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  SCENTIN  *) 
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(*  %INCLUDE  SCENTUP  *) 

(**) 

PROCEDURE  SCENTUP (VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  ENT_KEY  :  ENTKEY) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  UPDATES  THE  ENTITY  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK  *) 

(*  ENT  JOEY  I/O  KEY  OF  THE  ENTITY  TO  BE  UPDATED  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINES  TO  DISPLAY  *) 

(*  THE  DATA  ABOUT  THE  ENTITY.  THE  UPDATE  ENTITY  OPTIONS  IN-  *) 

(*  CLUDE  THE  FOLLOWING  :  *) 

(*  CHANGE  THE  ENTITY  NAME  OR  KIND  NUMBER,  *) 

(*  UPDATE  THE  ENTITY'S  CONSTITUENTS  (FIELDS)  BY  *) 

<*  ADDING  FIELDS,  REMOVING  FIELDS  OR  UPDATING  FIELDS,  *) 

(*  REVIEW  A  FIELD,  *) 

(*  DELETE  THE  ENTITY,  *) 

(*  SAVE  THE  CHANGES  MADE,  *) 

(*  RETURN  OR  EXIT.  *) 

(*  IF  SAVE  THE  CHANGES  WAS  SELECTED  THE  ENTITY  IS  UPDATED  *) 

(*  AND  THE  ENTITIES  ON  THE  DELETE  LIST  WILL  BE  DELETED  IF  *) 

(*  POSSIBLE.  IF  RETURN  OR  EXIT  IS  SELECTED  THE  ENTITIES  ON  *) 

(*  THE  NEW  KEYS  LIST  WILL  BE  DELETED  IF  POSSIBLE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 
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(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  REVISED:  09/28/87  C.  H.  MOHME  DBM  *) 

(*  INCORPORATED  THE  SUPERTYPE  DATA  TYPE.  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBM  *) 

(*  CORRECTED  EXIT  OPTION  SO  THAT  WHEN  EXIT  IS  SELECTED,  THE  *) 

(*  UPDATE  MENU  IS  REDISPLAYED.  *) 

(*  *) 

(*  REVISED:  07/28/87  C.  H.  MOHME  DBM  *) 

(*  MODIFIED  TO  PREVENT  ATTRIBUTES  FROM  BEING  ERRONEOUSLY  REMOVED  *) 

(*  FROM  AN  ENTITY  WHILE  UPDATING.  *) 

(*  *) 

(*  ORIGINATED:  07/01/86  L.  J.  BEHAN  FRMI  *) 

(*  *) 

(* - - - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  SCENTUP  *) 
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(*  %INCLUDE  SCENUCR  *) 

(**) 

PROCEDURE  SCENUCR(VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANSPTR) ; 

SUBPROGRAM; 

(**) 

(* - 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


^FUNCTION: 

THIS  ROUTINE  GATHERS  THE  DATA  NECESSARY  TO  CREATE  THE 
ENUMERITEM  ENTITY  AND  PUSHES  THE  DATA  ON  THE  TRANSACTION 
STACK. 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

<* 

<* 


^DESCRIPTION  OF  ARGUMENTS: 


-*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 


(* 

(* 

(* 

NAME 

I/O 

DESCRIPTION 

*) 

*) 

*) 

IRC 

0 

THE  RETURN  CODE 

(* 

TRANS_STACK 

I/O 

THE  TRANSACTION  STACK 

*) 

(* 

*) 

(* 

$ COMMONS : 

*) 

(* 

REF 

*) 

(* 

INSIDE 

I/O 

INDICATES  IF  THE  EXIT  OR 

RETURN  OPTION 

*) 

(* 

IS  CHOSEN  WITHIN  ANOTHER 

ROUTINE 

*) 

(* 

*) 

(* 

^ENVIRONMENT : 

*) 

<* 

LANGUAGE:  IBM 

PASCAL 

*) 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

INTERNAL  PROCEDURE 

FOR  THE  SCHEMA  EXECUTIVE 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION 

• 

• 

*) 

(* 

THIS  ROUTINE 

CALLS 

THE  MENU  INTERFACE  ROUTINE  CRENUM 

*> 

TO  DISPLAY  THE  PANEL.  THE  DATA  ENTERED  ON  THE  PANEL  IS 
VERIFIED  AND  IF  IT  IS  OK  IT  IS  PUSHED  ON  THE  TRANSACTION 
STACK  OR  THE  APPROPRIATE  ACTION  IS  TAKEN.  IF  ANY  OF  THE 
DATA  ENTERED  IS  INVALID  THEN  THE  PANEL  IS  REDISPLAYED  WITH 
AN  ERROR  MESSAGE. 

^COMMENTS: 

$ CHANGE  CONTROL: 


*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*> 
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(*  "/.INCLUDE  SCEXIST  *) 

(**) 

PROCEDURE  SCEXIST(VAR  IRC  :  RET_REC ; 

VAR  KIND_NUMBER  :  INTEGER; 

VAR  PRESENT  :  BOOLEAN; 

VAR  KEY_OF_ENT  :  ENTKEY); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  VERIFIES  THE  EXISTENCE  OF  AN  ENTITY  AND  *) 

(*  RETURNS  THE  ENTITY  KEY  IF  IT  DOES  IN  FACT  EXIST.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  KIND_NUMBER  I  THE  USER  DEFINED  KIND  NUMBER  OF  THE  *) 

(*  ENTITY  TO  BE  FOUND  *) 

(*  PRESENT  0  INDICATES  IF  THE  ENTITY  EXISTS  *) 

(*  KEY_OF_ENT  0  THE  KEY  OF  THE  ENTITY  FOUND  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *> 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  IS  CALLED  BY  A  MAS  EXECUTE  PROCEDURE.  THE  *) 

(*  SCHEMA  MODEL  IS  SEARCHED  FOR  A  CLASS  OR  ENTITY  WITH  A  *) 

(*  USER  DEFINED  KIND  NUMBER  IDENTICAL  TO  THE  ONE  PASSED  IN.  *) 

(*  IF  A  MATCH  IS  FOUND  THEN  THE  KEY  TO  THE  ENTITY  IS  RETURNED  *) 

(*  TO  THE  CALLING  PROCEDURE  AND  A  FLAG  IS  SET  TO  INDICATE  THAT  *) 

(*  A  MATCH  WAS  INDEED  FOUND.  IF  A  MATCH  IS  NOT  FOUND  THEN  *) 

(*  THE  FLAG  IS  SET  TO  FALSE.  *) 

<*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

<*  ’  *) 
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(*  %INCLUDE  SCFLDAD  *) 

(**) 

PROCEDURE  SCFLDAD (VAR  IRC  :  RET_REC ; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  LIST_OF_CNSTS  :  LISTKEY; 

VAR  FIELDTYP  :  T_FIELDTYPE ; 

VAR  FIELD_KEY  :  ENTKEY; 

VAR  DELETE_LIST  :  LISTKEY); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GATHERS  THE  DATA  TO  ADD  A  FIELD  TO  AN  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK  *) 

(*  LIST_OF_CNSTS  I/O  LIST  OF  CONSTITUENTS  OF  THE  ENTITY  *) 

(*  FIELDTYP  I  INDICATES  THE  TYPE  OF  FIELD  *) 

(*  FIELDJCEY  0  KEY  TO  THE  FIELD  CREATED  *) 

(*  DELETEJLIST  I  LIST  OF  KEYS  TO  BE  DELETED  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  .^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  ALLOWS  A  USER  TO  ADD  A  FIELD  TO  AN  ENTITY  *) 

(*  DURING  AN  UPDATE.  THE  ADD  FIELD  (ADDFIELD)  ROUTINE  IS  *) 

(*  CALLED  AND  THE  DATA  IS  GATHERED.  THEN  THE  TRANSACTION  *) 

(*  PROCESSING  ROUTINE  (SCTRSPR)  IS  CALLED  TO  MODEL  THE  FIELD  *) 

(*  ENTITY.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  REVISED:  JANUARY  1988  C.  H.  MOHME  DBMA  *) 
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(*  MODIFIED  TO  INCORPORATE  THE  STRUCTURE  DATA  TYPE  *) 

(*  *) 

(*  REVISED:  09/28/87  C.  H.  MOHME  DBMA  *) 

(*  INCORPORATED  THE  SUPERTYPE  DATA  TYPE.  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  FIELD  ADB  DATA;  ADDED  LIST  AND  SET.  NOTE:  THE  LIST  *) 

(*  AND  SET  DATA  TYPES  ARE  IMPLEMENTED  IN  THE  SOFTWARE  AS  AN  *) 

(*  ARRAY.  A  FIELD  WAS  ADDED  TO  THE  ARRAY  ADB  TO  SPECIFY  WHETHER  *) 

(*  THE  ARRAY  IS  A  CONCEPTUAL  ARRAY,  LIST,  OR  SET.  *) 

(*  *> 

(*  ORIGINATED:  07/21/86  L.  J.  BEHAN  DBMA  *) 

(*  *) 

<* - *) 

(*  *> 

(*END - *) 

(*  END  %INCLUDE  SCFLDAD  *) 
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(*  %INCLUDE  SCFLDCR  *) 
(**) 


PROCEDURE  SCFLDCR(VAR  IRC  :  RET_REC; 

VAR  FIELDTYP  :  T_FIELDTYPE ; 
VAR  TRANS_STACK  :  TRANS PXR); 


(**) 

(*-- 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

<* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 


SUBPROGRAM; 


^FUNCTION: 

THIS  ROUTINE  GATHERS  THE  DATA  NECESSARY  TO  MODEL  THE 
FIELD  ENTITY. 


^DESCRIPTION  OF  ARGUMENTS: 


NAME 


I/O  DESCRIPTION 


IRC 

FIELDTYP 
TRANS  STACK 


0  RETURN  CODE 

I  INDICATES  THE  TYPE  OF  FIELD 
I/O  POINTS  TO  THE  TRANSACTION  STACK 


$ COMMONS : 

REF 

INSIDE  I/O  INDICATES  IF  THE  EXIT  OR  RETURN  OPTION 

IS  CHOSEN  WITHIN  ANOTHER  ROUTINE 


^ENVIRONMENT : 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 


^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 


^PROCESSING  DESCRIPTION: 

THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINE  (CRFIELD) 

TO  DISPLAY  THE  CREATE  FIELD  PANEL.  THE  DATA  ENTERED  IS 
VERIFIED  AND  IF  IT  IS  VALID  IT  IS  PUSHED  ON  TO  THE  TRANS¬ 
ACTION  STACK  AND  THE  APPROPRIATE  FIELD  TYPE  ROUTINE  IS 
CALLED.  IF  THE  DATA  IS  INVALID  THE  PANEL  IS  REDISPLAYED 
WITH  AN  ERROR  MESSAGE.  THIS  PANEL  CONTINUES  TO  BE  DIS¬ 
PLAYED  UNTIL  EXIT  OR  NO  MORE  FIELDS  IS  CHOSEN. 

^COMMENTS : 


$ CHANGE  CONTROL: 


REVISED:  JANUARY  1988  C.  H.  MOHME  DBMA 

MODIFIED  TO  INCORPORATE  THE  STRUCTURE  DATA  TYPE 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 
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(*  REVISED:  09/29/87  C.  H.  MOHME  DBMA  *) 

(*  INCORPORATED  THE  SUPERTYPE  DATA  TYPE.  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  FIELD  ADB  DATA;  ADDED  LIST  AND  SET.  NOTE:  THE  LIST  *) 

(*  AND  SET  DATA  TYPES  ARE  IMPLEMENTED  IN  THE  SOFTWARE  AS  AN  *) 

(*  ARRAY.  A  FIELD  WAS  ADDED  TO  THE  ARRAY  ADB  TO  SPECIFY  WHETHER  *) 

(*  THE  ARRAY  IS  A  CONCEPTUAL  ARRAY,  LIST,  OR  SET.  '  *) 

(*  *) 

(*  ORIGINATED:  02/05/86  L.  J.  BEHAN  FRMI  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  SCFLDCR  *) 
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(*  %INCLUDE  SCFLDIN  *) 

(**) 

PROCEDURE  SCFLDIN (VAR  IRC  :  RETJREC; 

VAR  INCLD  :  TEXT; 

VAR  FIELD_LIST  :  LISTKEY; 

CONST  FIELD_DEF  :  T_FIELD_DEF) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  WRITES  THE  FIELD  TYPE  DECLARATION  TO  THE  *) 

(*  PASCAL  INCLUDE  FILE.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  I/O  RETURN  CODE  *) 

(*  INCLD  I  THE  FILE  NAME  *) 

(*  FIELD_LIST  I  A  LIST  OF  FIELDS  *) 

(*  FIELD_DEF  I  INDICATES  THE  FIELD  DEFINITION  TYPE  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  SET  THE  LIST  OF  FIELDS  TO  BE  READ  FORWARD  *) 

(*  CONTINUE  TO  READ  FIELDS  UNTIL  THE  END  OF  LIST  IS  FOUND  *) 

(*  GET  THE  KEY  TO  THE  NEXT  FIELD  *) 

(*  GET  THE  FIELD'S  ADB  *) 

(*  WRITE  TO  THE  FILE  <FIELD  NAME>  *) 

(*  IF  THE  TYPE  OF  DEFINITION  IS  ADB  THEN  *) 

(*  SET  THE  FIELD'S  CONSTITUENT  LIST  TO  BE  READ  FORWARD  *) 

(*  GET  THE  KEY  TO  THE  FIRST  ENTITY  ON  THE  CONSTITUENT  LIST  *) 

(*  GET  THE  CONSTITUENT’S  ADB  *) 

(*  CALL  THE  ROUTINE  TO  WRITE  OUT  THE  PRIMITIVE  TYPES  THAT  *) 

(*  WILL  APPEAR  IN  THE  ADB  OF  THE  ENTITY  *) 

(*  INTEGER  *) 

(*  REAL  *) 

(*  LOGICAL  ■  *) 
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(*  STRING  *) 

(*  DEFINED  TYPE  *) 

(*  ARRAY  *) 

(*  ELSE  *) 

(*  IF  THE  TYPE  OF  DEFINITION  IS  THE  CONSTITUENT  LIST  *) 

<*  POSITION  THEN  *) 

(*  WRITE  TO  THE  FILE  T_CL_POSITION;  *) 

(*  ELSE  ‘  *) 

(*  IF  THE  DEFINITION  TYPE  IS  CONSTITUENT  KEY  THEN  *) 

(*  WRITE  TO  THE  FILE  ENTKEY;  *) 

(*  END;  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %Include  SCFLDLST  *) 

(**) 

Procedure  SCFLDLST(  Var  Entity_Kind_Exists  :  Boolean; 

Const  Ent_Kind  :  Integer; 

Var  Field_List  :  Listkey  ); 

Subprogram; 


(**) 

(*-- 

(* 

(* 

(* 

c* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

<* 

(* 

(* 


- r.} 

*) 

^Function:  *) 

This  routine  creates  a  list  of  fields  that  are  constituents  *) 

of  a  specified  entity  type  (GLOBAL,  SUPERTYPE,  STRUCTURE,  *) 

or  ENTITY).  *) 

*) 

^Description  of  arguments:  *) 

*) 

Name  I/O  Description  *) 

*) 

Entity_Kind_Exists  0  Indicates  whether  an  instance  of  the  *) 

specified  entity  type  exists  in  the  *) 

model.  If  no  instances  exist,  then  *) 

a  list  of  fields  will  NOT  be  created.  *) 

*) 

Ent_Kind  I  The  specified  entity  kind  (GLOBAL,  *) 

SUPERTYPE,  STRUCTURE,  or  ENTITY)  for  *) 

which  a  list  of  fields  is  to  be  made.  *) 

*) 

Field_List  0  The  list  of  fields  that  are  constitu-  *) 

ents  of  the  specified  entity  type.  *) 

^Commons :  l] 

None  *) 

^Environment:  *) 

Language:  IBM  Pascal  *) 

Hardware  System:  IBM  360/370/4341/43S1  *) 

.  *> 

$Execution  Procedure:  *) 

Internal  procedure  for  the  Schema  Manager  *) 

^Processing  Description:  *) 

Set  ENTITY_KIND_EXISTS  to  FALSE.  *) 

Make  a  list  of  the  specified  entity  kind.  *) 

If  an  instance  of  the  specified  entity  kind  exists  in  the  *) 

model  then  *) 

Make  a  list  of  constituent  fields.  *) 
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(*  Delete  list  of  the  specified  kind.  *) 

(*  Set  ENTITY _KIND_EX1 STS  to  TRUE.  *) 

(*  *) 

(*  ^Comments:  *) 

(*  *) 

(*  ^Change  Control:  *) 

(*  *) 

(*  Originated:  01/06/88  C.  H.  Mohme  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*End - *) 

(*  End  %Include  SCFLDLST  *) 
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(*  ^INCLUDE  SCFLDSRT  *) 

(**) 

PROCEDURE  SCFLDSRT (CONST  CURRENT 

CONST  NEXT 
VAR  FLIP 
VAR  RRC 
VAR  PROC 

SUBPROGRAM; 

(**) 


ENTBLOCK; 
ENTBLOCK; 
BOOLEAN; 
EXT_RET_CODE ; 
ROUTINE) j 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

<* 

(* 

(* 

<* 

(* 

<* 

(* 

(* 

<* 

<* 

(* 

(* 

(* 

(* 


^FUNCTION: 

THIS  ROUTINE  FINDS  THE  KEY  AND  RETURNS  IT  TO  THE  CALLING 
PROCEDURE  GIVEN  A  NAME  OR  USER  DEFINED  KIND  NUMBER  AS  WELL 
AS  THE  ENTITY  KIND. 

^DESCRIPTION  OF  ARGUMENTS: 

NAME 

ENTITYJCEY 
ADB 
DATA 


RRC 


$ COMMONS : 

NONE 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 
^PROCESSING  DESCRIPTION: 

THIS  ROUTINE  IS  CALLED  BY  THE  MAS  EXECUTE  ROUTINES, 
MAKXEQ  AND  MAEXEQ.  THE  LIST  IS  SEARCHED  FOR  IDENTICAL 
DATA  AND  IF  IT  IS  FOUND  THE  ENTITY'S  KEY  IS  RETURNED  TO 
THE  CALLING  PROCEDURE  AS  WELL  A  FLAG  INDICATING  THAT  THE 
KEY  RETURNED  IS  THE  CORRECT  ONE. 

$ COMMENTS : 

$ CHANGE  CONTROL: 


I/O  DESCRIPTION 

I  KEY  TO  THE  ENTITY 
0  DATA  STORED  IN  THE  ADB 
I/O  THE  USER  DEFINED  DATA  STRUCTURE  USED 
TO  PASS  DATA  INTO  THIS  PROCEDURE  AND 
TO  GET  THE  DESIRED  OUTPUT  FROM  THE 
PROCEDURE 

0  EXTERNAL  RETURN  CODE 
=  0  OK 
>=  10  ERROR 


■*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*> 

*> 

*) 

*> 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  SCFLDST  *) 

(**) 

PROCEDURE  SCFLDST(VAR  IRC  :  RET_REC ; 

VAR  FIELD_LIST  :  LISTKEY; 

VAR  FIELDS_IN_ADB  :  LISTKEY; 

VAR  FIELDS_IN_CL  :  LISTKEY); 

SUBPROGRAM; 

<**) 


(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  SORTS  THE  FIELDS  INTO  TWO  GROUPS  AND  THEN  *) 

(*  ORDERS  THEM  ACCORDING  TO  OFFSET  OR  POSITION  DEPENDING  ON  *) 

(*  WHETHER  OR  NOT  THEY  ARE  IN  THE  LIST  OF  ADB  FIELDS  OR  THE  *) 

(*  LIST  OF  CONSTITUENT  FIELDS.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  I/O  RETURN  CODE  *) 

(*  FIELD_LIST  I  A  LIST  OF  FIELDS  *) 

(*  FIELDS_IN_ADB  0  A  LIST  OF  FIELDS  IN  THE  ADB  *) 

(*  FIELDS  IN_CL  0  A  LIST  OF  FIELDS  IN  THE  CONSTITUENT  LIST  *) 

(*  *) 

<*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  READS  EACH  ENTITY  FROM  THE  LIST  AND  WRITES  *) 

(*  OUT  THE  ENTITY  NAME  AND  CONSTANT  TO  THE  INCLUDE  FILE.  *) 

(*  *> 

(*  '$ COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  SCFLDUP  *) 

(**) 

PROCEDURE  SCFLDUP (VAR  IRC  :  RET_REC ; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  LIST_OF_FIELDS  :  LISTKEY; 

VAR  FIELDTYP  :  T_FIELDTYPE; 

VAR  FIELD_KEY  :  ENTKEY ; 

VAR  DELETE_LIST  :  LISTKEY; 

VAR  NEW_KEYS_LIST  :  LISTKEY); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GATHERS  THE  DATA  TO  UPDATE  THE  FIELD  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK  *) 

(*  LIST_OF_FIELDS  I/O  LIST  OF  THE  ENTITY'S  FIELDS  FROM  WHICH  *) 

(*  A  FIELD  IS  TO  BE  UPDATED  *) 

(*  FIELDTYP  I  TYPE  OF  FIELD  *) 

(*  FIELDJCEY  I/O  KEY  OF  THE  FIELD  TO  BE  UPDATED  *) 

(*  DELETEJLIST  I/O  LIST  OF  ENTITIES  TO  BE  DELETED  *) 

(*  NEW_KEYS_LIST  I/O  LIST  OF  NEWLY  CREATED  ENTITIES  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

<*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THE  DATA  ABOUT  THE  FIELD  ENTITY  IS  DISPLAYED  BY  CALLING  *) 

(*  THE  MENU  INTERFACE  ROUTINE  (UPFIELD) .  THE  USER  CAN  CHANGE  *) 

(*  ANY  OF  THE  DATA  ON  THE  PANEL  OR  SELECT  ONE  OF  THE  FOLLOWING  *) 

(*  OPTIONS  :  *) 

(*  REVIEW  THE  CURRENT  TYPE,  *) 

(*  UPDATE  THE  CURRENT  TYPE,  *) 

(*  SAVE  THE  CHANGES  MADE,  *) 

(*  RETURN  OR  EXIT.  ■  *) 
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(*  IF  SAVE  THE  CHANGES  IS  CHOSEN  AND  THE  USER  HAS  CHANGED  ANY  *) 
(*  OF  THE  FIELD  DATA  THE  FIELD  KEY  IS  PLACED  ON  THE  DELETE  *) 
(*  LIST  AND  A  NEW  FIELD  ENTITY  IS  MODELED.  THE  KEY  TO  THE  NEW  *) 


(* 

FIELD  ENTITY  IS  PLACE  ON  THE  NEW  KEYS  LIST. 

*) 

(* 

*) 

<* 

^COMMENTS: 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

*) 

(* 

REVISED:  JANUARY  1988  C.  H.  MOHME 

DBMA 

*) 

(* 

MODIFIED  TO  INCORPORATE  THE  STRUCTURE  DATA  TYPE 

*) 

(* 

*) 

(* 

REVISED:  09/28/87  C.  H.  MOHME 

DBMA 

*) 

(* 

INCORPORATED  THE  SUPERTYPE  DATA  TYPE. 

*) 

(* 

*) 

(* 

REVISED:  08/13/87  C.  H.  MOHME 

DBMA 

*) 

(* 

CHANGED  FIELD  ADB  DATA;  ADDED  LIST  AND  SET.  NOTE: 

THE  LIST 

*) 

(* 

AND  SET  DATA  TYPES  ARE  IMPLEMENTED  IN  THE  SOFTWARE 

AS 

AN 

*) 

(* 

ARRAY.  A  FIELD  WAS  ADDED  TO  THE  ARRAY  ADB  TO  SPECIFY 

WHETHER 

*) 

(* 

THE  ARRAY  IS  A  CONCEPTUAL  ARRAY,  LIST,  OR  SET. 

*) 

<* 

*) 

(* 

ORIGINATED:  08/05/86  L.  J.  BEHAN 

DBMA 

*) 

(* 

*) 

<*-• 

— 

— 

-*) 

(* 

*) 

(*END - 

— 

— 

._*) 

(*  END  %INCLUDE  SCFLDUP  *) 
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(*  %INCLUDE  SCFNDKEY  *) 

(**) 

PROCEDURE  SCFNDKEY (CONST  ENTITY_KEY  :  ENTKEY; 

VAR  ADB  :  ENTBLOCK; 

VAR  DATA  :  BLKDATA ; 

VAR  RRC  :  EXT_RET_CODE) ; 

SUBPROGRAM; 

(**) 

(* - 


^FUNCTION: 

THIS  ROUTINE  FINDS  THE  KEY  AND  RETURNS  IT  TO  THE  CALLING 
PROCEDURE  GIVEN  A  NAME  OR  USER  DEFINED  KIND  NUMBER  AS  WELL 
AS  THE  ENTITY  KIND. 


^DESCRIPTION  OF  ARGUMENTS: 

NAME  I/O  DESCRIPTION 


ENTITYJCEY 

ADB 

DATA 


KEY  TO  THE  ENTITY 

DATA  STORED  IN  THE  ADB 

THE  USER  DEFINED  DATA  STRUCTURE  USED 

TO  PASS  DATA  INTO  THIS  PROCEDURE  AND 

TO  GET  THE  DESIRED  OUTPUT  FROM  THE 

PROCEDURE 

EXTERNAL  RETURN  CODE 
=  0  OK 
>=  10  ERROR 


^COMMONS : 
NONE 


^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 
^PROCESSING  DESCRIPTION: 

THIS  ROUTINE  IS  CALLED  BY  THE  MAS  EXECUTE  ROUTINES, 
MAKXEQ  AND  MAEXEQ.  THE  LIST  IS  SEARCHED  FOR  IDENTICAL 
DATA  AND  IF  IT  IS  FOUND  THE  ENTITY'S  KEY  IS  RETURNED  TO 
THE  CALLING  PROCEDURE  AS  WELL  A  FLAG  INDICATING  THAT  THE 
KEY  RETURNED  IS  THE  CORRECT  ONE. 

^COMMENTS : 

$ CHANGE  CONTROL: 
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(*  %INCLUDE  SCGENRPT  *) 

(**) 

PROCEDURE  SCGENRPT (VAR  IRC  :  RET_REC; 

VAR  REPORTJTYPE  :  OPERATIONS; 

VAR  MSG  :  MESSAGE); 

SUBPROGRAM; 

(**) 

(* - - - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  DETERMINES  THE  SUBSCHEMA  FOR  WHICH  A  REPORT  *) 

(*  IS  TO  BE  GENERATED  AND  CALLS  THE  APPROPRIATE  ROUTINE  TO  *) 

(*  PRODUCE  THE  REPORT.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS :  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  I/O  RETURN  CODE  *) 

(*  REPORTJTYPE  I  TYPE  OF  REPORT  TO  BE  GENERATED  *) 

(*  MSG  I/O  PANEL  MESSAGE  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  A  PANEL  CONTAINING  A  LIST  OF  ALL  OF  THE  SUBSCHEMAS  *) 

C*  WITHIN  THE  SCHEMA  MODEL.  *) 

(*  IF  RETURN  OR  EXIT  WAS  NOT  CHOSEN  ON  THE  PANEL  THEN  *) 

(*  IF  A  MULTIPLE  SELECT  WAS  MADE  ON  THE  PANEL  THEN  *) 

(*  DISPLAY  AN  ERROR  MESSAGE  *) 

(*  ELSE  *) 

(*  GET  THE  KEY  OF  THE  SUBSCHEMA  SELECTED  *) 

(*  IF  THE  SUBSCHEMA  HAS  NOT  BEEN  PHYSICALIZED  THEN  *) 

(*  PHYSICALIZE  THE  SUBSCHEMA  *) 

(*  CALL  THE  APPROPRIATE  ROUTINE  TO  PRODUCE  A  REPORT  *) 

(*  ELSE  *) 

(*  IF  RETURN  WAS  SELECTED  THEN  *) 

(*  RETURN  TO  THE  REPORT  MENU  *) 

(*  ELSE  *) 

(*  IF  EXIT  WAS  SELECTED  THEN  •  *) 
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(* 

RETURN  TO  THE  MAIN  MENU 

*) 

*) 

*) 

c* 

ELSE 

(* 

(* 

DISPLAY  AN  ERROR  MESSAGE  FOR  AN  INVALID  OPTION 

END , 

(* 

*) 

(* 

$ COMMENTS: 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

*) 

*) 
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(*  % INCLUDE  SCHDVR  *) 

(**) 

<* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  IS  THE  MAINLINE  PROGRAM  WHICH  DRIVES  THE  SCHEMA  *) 

(*  EXECUTIVE  PACKAGE .  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  DEF  *) 

(*  CURRENT_LIST  I/O  POINTS  TO  THE  LIST  KEY  CURRENTLY  *) 

(*  IN  USE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERFACE  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  INITIALIZES  THE  NETWORK,  THEN  DETERMINES  *) 

(*  IF  THE  PACKAGE  IS  TO  BE  USED  INTERACTIVELY  OR  BY  BATCH  *) 

(*  AND  CONTINUES  PROCESSING  ACCORDINGLY.  *) 

(*  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $  CHANGE  CONTROL:  *) 

<*  *) 
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(*  %INCLUDE  SCINCLD  *) 

(**) 

PROCEDURE  SCINCLD(VAR  SUBSCHEMA_KEY  :  ENTKEY; 

VAR  IRC  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - - - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GENERATES  THE  PASCAL  INCLUDE  FILES  AND  WRITES  *) 

(*  THESE  DEFINITIONS  TO  A  FILE  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  I/O  RETURN  CODE  *) 

(*  MSG  I/O  PANEL  MESSAGE  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  INITIALIZE  VARIABLES  *) 

(*  GET  THE  ADB  OF  THE  SUBSCHEMA  AND  DETERMINE  IF  IT  HAS  BEEN  *) 

(*  PHYSICALIZED.  *) 

(*  IF  THE  SUBSCHEMA  HAS  NOT  BEEN  PHYSICALIZED,  THEN  PHYSICALIZE  *) 

(*  IT.  *) 

(*  WRITE  THE  HEADING  TO  THE  FILE  *) 

(*  WRITE  OUT  TO  THE  FILE  THE  SUBSCHEMA  COMMENT,  IF  ONE  EXISTS  *) 

(*  MAKE  A  LIST  OF  ALL  OF  THE  ENTITIES  WITHIN  THE  SUBSCHEMA  *) 

(*  DELETE  ANY  DUPLICATE  ENTRIES  OFF  OF  THE  LIST  *) 

(*  SORT  THE  LIST  OF  ENTITIES  ALPHABETICALLY  *) 

(*  CALL  THE  ROUTINE  TO  WRITE  THE  ENTITY  KIND  CONSTANTS  TO  THE  *) 

(*  FILE  *) 

(*  CALL  THE  ROUTINE  TO  WRITE  THE  DEFINED  TYPES  TO  THE  FILE  *) 

C*  CALL  THE  ROUTINE  TO  WRITE  THE  ENTITY  DECLARATIONS  TO  THE  FILE  *) 

(*  CALL  THE  ROUTINE  TO  WRITE  THE  MAS  DECLARATIONS  TO  THE  FILE  *) 

(*  CALL  THE  ROUTINE  TO  WRITE  THE  CONSTITUENT  DECLARATIONS  TO  THE  *) 

(*  FILE  *) 

(*  CHECK  FOR  ERROR  CONDITIONS  *  *) 
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(*  DELETE  ALL  OF  THE  LISTS  CREATED  IN  THIS  ROUTINE 
(* 

(*  $ COMMENTS : 

(* 

(*  $ CHANGE  CONTROL: 
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(*  %INCLUDE  SCINTCR  *) 

(**) 

PROCEDURE  SCINTCR (VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANSPTR) ; 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GATHERS  THE  DATA  NECESSARY  TO  CREATE  THE  *) 

(*  INTEGER  ENTITY  AND  PUSHES  THE  DATA  ON  THE  TRANSACTION  *) 

(*  STACK.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  THE  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  THE  TRANSACTION  STACK  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  REF  *) 

(*  INSIDE  I/O  INDICATES  IF  THE  EXIT  OPTION  OR  *) 

(*  THE  RETURN  OPTION  IS  CHOSEN  WITHIN  *) 

(*  ANOTHER  ROUTINE  *) 

<*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINE  CRINTEGR  *) 

(*  TO  DISPLAY  THE  PANEL.  THE  DATA  ENTERED  ON  THE  PANEL  IS  *) 

(*  VERIFIED  AND  IF  IT  IS  OK  IT  IS  PUSHED  ON  THE  TRANSACTION  *) 

(*  STACK.  OTHERWISE,  IF  THE  DATA  ENTERED  IS  INVALID  THE  *) 

(*  PANEL  IS  REDISPLAYED.  *) 

(*  *) 

(*  $ COMMENTS :  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 
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(*  %INCLUDE  SCINTUP  *) 

(**) 

PROCEDURE  SCINTUP(VAR  IRC  :  RET_REC; 

VAR  INTEGER_KEY  :  ENTKEY; 

VAR  NUMBER_OF_USERS  :  INTEGER; 

VAR  DELETE_LIST  :  LISTKEY; 

VAR  NEW_KEYS_LIST  :  LISTKEY); 

SUBPROGRAM; 

(**) 

<* - 

(* 

(*  $ FUNCTION; 

(*  THIS  ROUTINE  UPDATES  THE  INTEGER  ENTITY. 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 

(*  NAME  I/O  DESCRIPTION 

(*  INTEGER_KEY  I/O  KEY  OF  THE  ENTITY  TO  BE  UPDATED 

(*  NUMBER_OF_USERS  I  NUMBERS  OF  USERS  OF  THE  INTEGER  ENTITY 

(*  DELETE_LIST  I/O  LIST  OF  ENTITIES  TO  BE  DELETED 

(*  NEW_KEYS_LIST  I/O  LIST  OF  NEWLY  CREATED  ENTITIES 

(*  IRC  0  RETURN  CODE 

(* 

(*  $ COMMONS : 

(*  NONE 

(* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(*  THIS  ROUTINE  DISPLAYS  THE  PRECISION  OF  THE  INTEGER  ENTITY 

(*  AND  ALLOWS  THE  USER  TO  CHANGE  THE  INFORMATION  IF  HE/SHE  SO 

(*  DESIRES.  IF  A  CHANGE  IS  MADE  AND  THE  NUMBER  OF  USERS  OF 

(*  THE  OLD  INTEGER  ENTITY  IS  ONE  OR  LESS  THEN  ITS  KEY  IS 

(*  PLACED  ON  THE  DELETE  LIST.  AFTER  THE  NEW  INTEGER  ENTITY 

(*  IS  CREATED  ITS  KEY  IS  PLACED  ON  THE  NEW  KEYS  LIST. 

(* 

(*  ^COMMENTS: 

<* 

(*  $ CHANGE  CONTROL: 

(* 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*' 
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(*  ^INCLUDE  SCKEFIND  *) 

(**) 

PROCEDURE  SCKEFIND(VAR  IRC  :  RET_REC; 

CONST  ENT_KIND  :  INTEGER; 
VAR  ENT_KEY  :  ENTKEY; 

VAR  CREATE  :  BOOLEAN; 

VAR  CONTEXT  :  T_C0NTEXT) ; 

SUBPROGRAM; 

(**) 


<*- 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

<* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

<* 

<* 

(* 

(* 

(* 


^FUNCTION: 

THIS  ROUTINE  GETS  THE  KEY  TO  THE  ENTITY  TO  BE  UPDATED  OR 
REVIEWED. 

^DESCRIPTION  OF  ARGUMENTS: 

NAME 

ENTJCIND 
ENTJCEY 
CREATE 
IRC 

CONTEXT 


$ COMMONS : 

NONE 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 
^PROCESSING  DESCRIPTION: 

THIS  ROUTINE  MAKES  A  LIST  OF  ENTITIES  OF  THE  KIND 
SPECIFIED  AND  DISPLAYS  THIS  LIST  OF  ENTITIES  BY  CALLING 
THE  MENU  INTERFACE  ROUTINE  (DISPLIST).  IF  AN  ENTITY  IS 
CHOSEN  THEN  MAKXEQ  IS  CALLED  TO  GET  THE  KEY  TO  THE  ENTITY 
IF  IT  EXISTS.  IF  AN  INVALID  PICK  IS  MADE  A  MESSAGE  IS 
DISPLAYED  ON  THE  DISPLIST  PANEL. 

^COMMENTS : 

$ CHANGE  CONTROL: 


I/O  DESCRIPTION 

I  KIND  OF  THE  ENTITY 
0  KEY  OF  THE  ENTITY 
0  INDICATES  WHETHER  CREATE  OR  REVIEW 
0  RETURN  CODE 

I  THE  CONTEXT  IN  WHICH  THE  KEY  IS  TO  BE 
CREATED 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 
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(*  7.INCLUDE  SCKEYIN  *) 

(**) 

PROCEDURE  SCKEYIN(VAR  IRC  :  RET_REC ; 

VAR  INCLD  :  TEXT; 

VAR  ENTITY_LIST  :  LISTKEY; 

VAR  CL_DEFN  :  LISTKEY); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  ^FUNCTION:  *) 

(*  THIS  ROUTINE  WRITES  THE  KEYBLOCK  TYPE  DECLARATION  TO  THE  *) 

(*  PASCAL  INCLUDE  FILE.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  I/O  RETURN  CODE  *) 

(*  INCLD  I  THE  FILE  NAME  *) 

(*  ENTITY_LIST  I  A  LIST  OF  ENTITIES  *) 

(*  CL_DEFN  I  A  LIST  OF  ENTITIES  WHO  HAVE  CONSTITUENT  *) 

(*  LIST  DEFINITIONS  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  WRITE  THE  KEYBLOCK  HEADING  TO  THE  FILE  *) 

(*  WRITE  TYPE  TO  THE  FILE  *) 

(*  WRITE  OUT  TO  THE  FILE  KEYBLOCK  =  RECORD  *) 

(*  WRITE  OUT  TO  THE  FILE  CASE  INTEGER  OF  *) 

(*  ’  SET  THE  LIST  OF  ENTITIES  TO  BE  READ  IN  THE  FORWARD  *) 

(*  CONTINUE  TO  READ  ENTITIES  UNTIL  THE  END  OF  LIST  IS  FOUND  *) 

(*  GET  THE  KEY  TO  THE  NEXT  ENTITY  ON  THE  LIST  *) 

(*  GET  THE  ENTITY'S  ADB  *) 

(*  WRITE  TO  THE  FILE  C_<ENTITY  NAME>  :  *) 

(*  IF  THE  ENTITY  IS  IN  THE  LIST  OF  GENERATED  CONSTITUENT  *) 

(*  DEFINITIONS  THEN  *) 

(*  WRITE  TO  THE  FILE  (<ENTITY  NAME>  :  C_<ENTITY  NAME>) ;  *) 

(*  ELSE  -  *) 
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(*  WRITE  TO  THE  FILE  (); 

(*  END; 

(* 

(*  $ COMMENTS: 

(* 

(*  $ CHANGE  CONTROL: 

(* 


*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  SCLISTCR  *) 

(**) 

PROCEDURE  SCLISTCR(VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  *  TRANSPTR; 

VAR  CONTEXT  ;  T_CONTEXT); 

SUBPROGRAM; 

(**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  GATHERS  THE  DATA  NECESSARY  TO  CREATE  THE 

(*  LIST  ENTITY  AND  PUSHES  THE  DATA  ON  THE  TRANSACTION 

(*  STACK. 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 

(*  NAME  I/O  DESCRIPTION 

(*  IRC  0  THE  RETURN  CODE 

(*  TRANS_STACK  I/O  THE  TRANSACTION  STACK 

(*  CONTEXT  I  THE  CONTEXT  IN  WHICH  THE  LIST  IS  BEING 

(*  CREATED 

(* 

(*  $ COMMONS : 

(*  REF 

(*  INSIDE  I/O  INDICATES  IF  THE  EXIT  OR  RETURN  OPTION 

(*  IS  CHOSEN  WITHIN  ANOTHER  ROUTINE 

(* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(*  THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINE  CRLIST 

(*  TO  DISPLAY  THE  PANEL.  THE  DATA  ENTERED  ON  THE  PANEL  IS 

(*  VERIFIED  AND  IF  IT  IS  OK  IT  IS  PUSHED  ON  THE  TRANSACTION 

(*  STACK  OR  THE  APPROPRIATE  ACTION  IS  TAKEN.  IF  ANY  OF  THE 

(*  DATA  ENTERED  IS  INVALID  THEN  THE  PANEL  IS  REDISPLAYED 

(*  WITH  AN  ERROR  MESSAGE. 

(* 

(*  ^COMMENTS: 

c* 

<*  ^'CHANGE  CONTROL: 

<* 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  SCLISTUP  *) 

(**) 

PROCEDURE  SCLISTUP(VAR  IRC  :  RET_REC; 

VAR  TRANS_STAGK  :  TRANSPTR; 

VAR  LIST_KEY  :  ENTKEY; 

VAR  NUMBER_OF_USERS  :  LISTKEY; 

VAR  DELETE_LIST  :  LISTKEY; 

VAR  NEW_KEYS_LIST  :  LISTKEY; 

VAR  CONTEXT  :  T_CONTEXT); 

SUBPROGRAM; 

(**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  GATHERS  THE  DATA  TO  UPDATE  A  LIST. 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 

(*  NAME  I/O  DESCRIPTION 

(*  IRC  0  RETURN  CODE 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK 

(*  LISTJCEY  I/O  KEY  OF  THE  LIST  TO  BE  UPDATED 

(*  NUMBER_OF_USERS  I/O  THE  NUMBER  OF  USERS  OF  THE  LIST 

(*  DELETE_LIST  I/O  LIST  OF  ENTITIES  TO  BE  DELETED 

(*  NEW_KEYS_LIST  I/O  LIST  OF  NEWLY  CREATED  ENTITIES 

(*  CONTEXT  I  THE  CONTEXT  IN  WHICH  THE  LIST  IS  BEING 

(*  UPDATED 

(* 

(*  $ COMMONS : 

(*  NONE 

(* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

<* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(*  THE  CURRENT  LIST  DATA  IS  DISPLAYED  ON  THE  UPLIST  PANEL. 

(*  THE  DATA  CAN  THEN  BE  UPDATED  BY  THE  USER. 

c* 

(*  $ COMMENTS: 

(* 

(*  ^CHANGE  CONTROL: 

(* 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 


3-520 


Cl  PS560240032U 
April  1990 


(*  ^INCLUDE  SCMASIN  *) 
(**) 

PROCEDURE  SCMASIN(VAR 
VAR 
VAR 
VAR 


IRC 

INCLD 

ENTITY_LIST 
ADB  DEFN 


SUBPROGRAM; 

(**) 


RET_REC ; 
TEXT; 
LISTKEY; 
LISTKEY); 


<* - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  WRITES  THE  MAS  ADB  DECLARATION  TO  THE  PASCAL 

(*  INCLUDE  FILE. 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 


(* 

(* 

(* 

NAME 

I/O 

DESCRIPTION 

IRC 

I/O 

RETURN  CODE 

(* 

INCLD 

I 

THE  FILE  NAME 

(* 

ENTITYJjIST 

I 

A  LIST  OF  ENTITIES 

<* 

ADB_DEFN 

I 

A  LIST  OF  ENTITIES  THAT  HAVE  AN  ADB 

(* 

DEFINITION  GENERATED 

(* 

(* 

$ COMMONS : 

(* 

NONE 

(* 

(* 

^ENVIRONMENT: 

(* 

LANGUAGE:  IBM 

PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 

(* 

(*  ^PROCESSING  DESCRIPTION: 

<*  WRITE  THE  HEADING  TO  THE  FILE 

(*  WRITE  THE  FOLLOWING  TO  THE  FILE 

(*  ENTBLOCK  =  RECORD 


(* 

KIND 

INTEGER; 

(* 

LENGTH 

INTEGER; 

(* 

SYSUSE 

INTEGER; 

(* 

VERSION 

INTEGER; 

(* 

SYS_IDENT 

INTEGER; 

(* 

I  DENT 

INTEGER; 

(* 

CASE  INTEGER  OF 

(* 

SET  THE  LIST  OF  ENTITIES  TO  BE  READ 

FORWARD 

(* 

CONTINUE  TO  READ  ENTITIES  UNTIL  THE 

END 

OF  LIST  IS  FOUND 

(* 

GET  THE  KEY  TO  THE  NEXT  ENTITY  IN  THE 

LIST 

-*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  GET  THE  ENTITY'S  ADB  *) 

(*  WRITE  TO  THE  FILE  K_<ENTITY  NAME>  :  *) 

(*  IF  THE  ENTITY  IS  IN  THE  LIST  OF  GENERATED  ADB  DEFINITIONS  *) 

(*  WRITE  TO  THE  FILE  (<ENTITY  NAME>  :  E_<ENTITY  NAME> ) ;  *) 

(*  ELSE  *) 

(*  WRITE  TO  THE  FILE  ();  *) 

(*  END;  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  *) 


) 


Cl  PS560240032U 
April  1990 


(*  ^INCLUDE  SCMEMAD  *) 

(**) 

PROCEDURE  SCMEMAD(VAR  IRC  :  RET_REC; 

VAR  ENTJCEY:  ENTKEY; 

VAR  LIST_OF_CNSTS  :  LISTKEY; 
VAR  CHOSEN_KEY  :  ENTKEY); 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  DISPLAYS  A  LIST  OF  MEMBERS  FROM  WHICH  THE  *) 

(*  USER  CAN  SELECT.  THE  ENTITY  KEY  OF  THE  MEMBER  SELECTED  IS  *) 

(*  RETURNED.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  THE  INTERNAL  RETURN  CODE  INDICATING  *) 

(*  WHETHER  AN  ERROR  HAS  OCCURRED.  *) 

(*  ENT_KEY  I  THE  KEY  OF  THE  ENTITY  TO  WHICH  MEMBERS  *) 

(*  ARE  BEING  ADDED  *) 

(*  LIST_OF_CNSTS  I  THE  LIST  OF  ALL  CONSTITUENTS  *) 

(*  CHOsIn  KEY  0  THE  ENTITY  KEY  OF  THE  MEMBER  SELECTED  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *> 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  BEGINS  WITH  THE  CONSTITUENT  LIST  AND  REMOVES  *) 

(*  FROM  IT  THOSE  CONSTITUENTS  WHICH  ARE  ALREADY  MEMBERS.  IT  *) 

(*  ■  ALSO  REMOVES  THE  CONSTITUENT  TO  WHICH  MEMBERS  ARE  BEING  *) 

(*  ADDED.  THE  PANEL  DISPLIST  DISPLAYS  THE  MEMBERS  AND  THE  *) 

(*  USER  CAN  SELECT  ONE.  THE  ENTITY  KEY  OF  THE  MEMBER  SE-  *) 

(*  LECTED,  IF  ANY,  IS  RETURNED.  *) 

(*  *) 

(*  $ COMMENTS :  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  '  *) 
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(*  %INCLUDE  SCMEMLST  *) 

(**) 

PROCEDURE  SCMEMLST(VAR  IRC  :  RET_REC ; 

VAR  TRANS_STACK  :  TRANS PXR; 

VAR  ENTTYP  :  ENTITYJTYPE) ; 

SUBPROGRAM; 

(**) 

(* - - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  LISTS  OUT  THE  CURRENT  MEMBERS /CONSTITUENTS  OF  *) 

(*  THE  ENTITY,  CLASS,  SUBSCHEMA,  POINTER,  STRUCTURE,  GLOBAL  *) 

(*  FIELD  AND  ENUMERATION  ENTITIES.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  POINTER  TO  THE  TRANSACTION  STACK  *) 

(*  ENTJTYP  I  THE  ENTITY  TYPE  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  SEARCHES  THROUGH  THE  TRANSACTION  STACK  FOR  *) 

(*  THE  CONSTITUENTS  OF  THE  ENTITY  TYPE  PASSED  IN.  THE  CON-  *) 

(*  STITUENT  NAMES  ARE  PLACED  IN  AN  ARRAY  THAT  IS  DISPLAYED  *) 

(*  BY  CALLING  THE  MENU  INTERFACE  ROUTINE  (LMEM23) .  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  SCPOPKE  *) 

(**) 

PROCEDURE  SCPOPKE(VAR  IRC  :  RET_REC) ; 

SUBPROGRAM; 

<**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  'POPS’  A  KEY  OFF  OF  THE  KEY  STACK.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  THE  RETURN  CODE  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  REF  *) 

(*  CURRENT_LIST  0  LIST  KEY  POPPED  OFF  OF  THE  KEY  STACK  *) 

(*  KEY_STACK  I/O  POINTER  TO  THE  KEY  STACK  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  IF  THE  KEY  STACK  IS  NIL  THEN  AN  ERROR  MESSAGE  IS  RETURNED  *) 

(*  TO  THE  CALLING  PROCEDURE.  OTHERWISE,  THE  KEY  DATA  IS  *) 

(*  'POPPED'  OFF  OF  THE  STACK  AND  THE  NODE  IS  DISPOSED  OF  BY  *) 

(*  CALLING  THE  EUILT  IN  PASCAL  PROCEDURE  'DISPOSE'.  *) 

(*  *) 

<*  ^COMMENTS:  *) 

(*  TEXT  OF  ANY  FURTHER  COMMENTS  WHICH  MIGHT  HELP  TO  UNDERSTAND  *) 

(*  THE  FUNCTION/EXECUTION  OF  THIS  ROUTINE.  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 


3-525 


Cl  PS560240032U 
April  1990 


n 


(*  %INCLUDE  SCPOPTR  *) 

(**) 

PROCEDURE  SCPOPTR(VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANS PTR; 
VAR  DATA  :  TRANSACTION); 

SUBPROGRAM; 

(**) 


(* - - - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  'POPS'  THE  TRANSACTION  DATA  OFF  OF  THE  *) 

(*  DYNAMICALLY  ALLOCATED  STACK.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK  *) 

(*  DATA  0  THE  TRANSACTION  DATA  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  IF  THE  TRANSACTION  STACK  IS  NIL  THEN  AN  ERROR  MESSAGE  IS  *) 

(*  RETURNED  TO  THE  CALLING  PROCEDURE.  OTHERWISE,  THE  TRANS-  *) 

<*  ACTION  DATA  IS  'POPPED'  OFF  OF  THE  STACK  AND  THE  NODE  *) 

(*  IS  DISPOSED  OF  BY  CALLING  THE  BUILT  IN  PASCAL  PROCEDURE  *) 

(*  DISPOSE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

<*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  SCPRMFL  *) 

(**) 

PROCEDURE  SCPRMFL (VAR  IRC  :  RET_REC ; 

VAR  LIST_OF_ENTITIES  :  LISTKEY; 

VAR  LISTARRAY  :  T_ARRAYTV ; 

VAR  INDEX  :  INTEGER); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  FILLS  AN  ARRAY  WITH  THE  NAMES  OF  THE  ENTITIES  *) 

(*  IN  THE  LIST  OF  ENTITIES.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  LI5T_OF_ENTITIES  I  LIST  OF  ENTITIES  TO  BE  PUT  IN  ARRAY  *) 

(*  LISTARRAY  I/O  ARRAY  CONTAINING  THE  ENTITY  NAMES  *) 

(*  INDEX  I/O  INDEX  OF  THE  CURRENT  ARRAY  POSITION  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE;:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THE  LIST  OF  ENTITIES  PASSED  IN  IS  TRAVERSED  AND  EACH  *) 

<*  ENTITY’S  ADB  IS  RETRIEVED.  THE  ENTITY'S  ADB  DATA  IS  *) 

(*  TRANSLATED  INTO  CHARACTER  FORMAT  IF  NECESSARY,  AND  IS  *) 

<*  PLACED  INTO  THE  LISTARRAY.  THIS  PROCESS  CONTINUES  UNTIL  *) 

(*  THE  END  OF  THE  LIST  IS  ENCOUNTERED  OR  THE  MAXIMUM  ARRAY  *) 

(*  SIZE  IS  EXCEEDED.  *) 

(*  *) 

(*  $ COMMENTS :  *) 

<*  *> 

(*  ^CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  SCPRMRE  *) 

(**) 

PROCEDURE  SCPRMRE (VAR  IRC  :  RETJREC; 

VAR  ENT_KEY  :  ENTKEY) ; 

SUBPROGRAM; 

(**) 

(* - *> 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GATHERS  THE  DATA  TO  REVIEW  THE  ENTITIES  AND  *) 

(*  CALLS  THE  MENU  INTERFACE  ROUTINES  TO  DISPLAY  THIS  DATA.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  ENTJCEY  I  KEY  OF  THE  ENTITY  TO  BE  REVIEWED  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  FIRST  THE  ADB  OF  THE  ENTITY  PASSED  IN  MUST  BE  RETRIEVED,  *) 

(*  THEN  ACCORDING  TO  THE  ENTITY'S  TYPE  THE  ADB  DATA  IS  TRANS-  *) 

(*  LATED  INTO  CHARACTER  FORMAT  IF  IT  IS  NECESSARY.  IF  THE  *) 

(*  ENTITY  HAS  CONSTITUENTS  THAT  ARE  TO  BE  DISPLAYED  WITH  THE  *) 

(*  ENTITY’S  DATA,  THEN  THE  DATA  ABOUT  THE  CONSTITUENTS  MUST  *) 

(*  BE  PUT  INTO  A  FORMAT  THE  CAN  BE  DISPLAYED  ALSO.  THEN  THE  *) 

(*  APPROPRIATE  MENU  INTERFACE  ROUTINE  IS  CALLED  TO  DISPLAY  *) 

(*  THIS  INFORMATION.  *) 

(*  *) 

(*  $ COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  REVISED:  JANUARY  1988  C.  H.  MOHME  DBMA  *) 

(*  MODIFIED  TO  INCORPORATE  THE  STRUCTURE  DATA  TYPE  *) 

(*  *) 

(*  REVISED:  09/28/87  C.  H.  MOHME  DBMA  *) 
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(*  INCORPORATED  THE  SUPERTYPE  DATA  TYPE.  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  ADDED  LIST  AND  SET.  NOTE:  THE  LIST  AND  SET  DATA  TYPES  ARE  *) 

(*  IMPLEMENTED  IN  THE  SOFTWARE  AS  AN  ARRAY.  A  FIELD  WAS  ADDED  *) 

(*  TO  THE  ARRAY  ADB  TO  SPECIFY  WHETHER  THE  ARRAY  IS  A  CONCEPTUAL  *) 

(*  ARRAY,  LIST,  OR  SET.  *) 

(*  *) 

(*  ORIGINATED:  05/29/86  L.  J.  BEHAN  FRMI  *) 

(*  *) 

(* - *) 

<*  *) 

(*END - *) 

(*  END  ^INCLUDE  SCPRMRE  *) 
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(*  %INCLUDE  SCPTRCR  *) 

(**) 

PROCEDURE  SCPTRCR(VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANS PTR) ; 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GATHERS  THE  DATA  NECESSARY  TO  CREATE  THE  *) 

(*  POINTER  ENTITY  AND  PUSHES  THE  DATA  ON  THE  TRANSACTION  *) 

(*  STACK.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  THE  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  THE  TRANSACTION  STACK  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  REF  *) 

(*  INSIDE  I/O  INDICATES  IF  THE  EXIT  OR  RETURN  OPTION  *) 

(*  IS  CHOSEN  WITHIN  ANOTHER  ROUTINE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINE  CRPNTR  *) 

(*  TO  DISPLAY  THE  PANEL.  THE  DATA  ENTERED  ON  THE  PANEL  IS  *) 

(*  VERIFIED  AND  IF  IT  IS  OK  IT  IS  PUSHED  ON  THE  TRANSACTION  *) 

(*  STACK  OR  THE  APPROPRIATE  ACTION  IS  TAKEN.  IF  ANY  OF  THE  *) 

(*  DATA  IS  INVALID  THE  PANEL  IS  REDISPLAYED  WITH  AN  ERROR  *) 

(*  MESSAGE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

<*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  SCPTRUP  *) 

(**) 

PROCEDURE  SCPTRUP(VAR  IRC 

VAR  POINTER_KEY 
VAR  NUMBER_OF_USERS 
VAR  DELETE_LIST 
VAR  NEW_KEYS_LIST 

SUBPROGRAM; 


RET_REC; 

ENTKEY; 

INTEGER; 

LISTKEY; 

LISTKEY); 


(**) 

(* - *) 


(* 

*) 

(* 

^FUNCTION: 

*) 

(* 

THIS  ROUTINE  GATHERS 

THE  DATA  TO  UPDATE  THE  POINTER  ENTITY. 

*) 

(* 

*) 

(* 

^DESCRIPTION  OF  ARGUMENTS : 

*) 

(* 

NAME  I/O 

DESCRIPTION 

*) 
*  ^ 

(* 

POINTERJCEY  I/O 

KEY  OF  THE  ENTITY  TO  BE  UPDATED 

) 

*) 

(* 

NUMBER_OF_USERS  I 

THE  NUMBER  OF  USERS  OF  THIS  ENTITY 

*> 

(* 

DELETE.LIST  I/O 

LIST  OF  ENTITIES  TO  DELETE  IF  THE 

*) 

(* 

CHANGES  MADE  ARE  SAVED 

*) 

(* 

NEW_KEYS_LIST  I/O 

LIST  OF  ENTITIES  JUST  CREATED  DURING 

*) 

(* 

THE  UPDATE  PROCESS 

*) 

<* 

IRC  0 

RETURN  CODE 

*) 

(* 

*) 

(* 

$ COMMONS : 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

^ENVIRONMENT: 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

*> 

(* 

HARDWARE  SYSTEM:  IBM 

360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 

*) 

(*  *) 
(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINE  (UPPNTR)  *) 

(*  WHICH  DISPLAYS  INFORMATION  ABOUT  THE  POINTER  ENTITY.  THE  *) 

(*  UPDATE  POINTER  OPTIONS  INCLUDE  THE  FOLLOWING  :  *) 

(*  UPDATE  THE  CONSTITUENT  LIST  BY  ADDING  OR  REMOVING  AN  *) 

(*  ELEMENT,  *) 

(*  REVIEW  A  CONSTITUENT,  *) 

(*  SAVE  THE  CHANGES  MADE,  *) 

(*  RETURN  AND  EXIT.  *) 

(*  IF  THE  CONSTITUENT  LIST  WAS  CHANGED  AND  NO  MORE  CHANGES  *) 

(*  WAS  SELECTED  THE  OLD  POINTER  ENTITY  KEY  IS  PLACED  ON  THE  *) 

(*  DELETE  LIST  AND  A  NEW  POINTER  ENTITY  IS  MODELED.  THE  NEW  *) 
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(*  POINTER  ENTITY  KEY  IS  PLACED  ON  THE  NEW  KEYS  LIST.  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *? 

(*  *) 

*) 
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(*  ^INCLUDE  SCPUSHKE  *) 

(**) 

PROCEDURE  SCPUSHKE(VAR  IRC  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  ’PUSHES'  THE  KEY  DATA  ON  TO  THE  DYNAMICALLY  *) 

(*  ALLOCATED  KEY  STACK.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  THE  RETURN  CODE  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  REF  *) 

(*  CURRENT_LIST  I/O  A  KEY  TO  THE  LIST  CURRENTLY  IN  USE  *) 

(*  KEY_STACK  I/O  POINTER  TO  THE  KEY  STACK  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  A  NODE  IS  DYNAMICALLY  ALLOCATED  BY  CALLING  THE  BUILT  IN  *) 

(*  PROCEDURE  'NEW'.  THE  KEY  DATA  IS  THEN  'PUSHED'  ONTO  THE  *) 

(*  KEY  STACK.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  TEXT  OF  ANY  FURTHER  COMMENTS  WHICH  MIGHT  HELP  TO  UNDERSTAND  *) 

(*  THE  FUNCTION/EXECUTION  OF  THIS  ROUTINE.  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *> 
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(*  %INCLUDE  SCPUSHTR  *) 

(**) 

PROCEDURE  SCPUSHTR(VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANSPTR; 

CONST  DATA  :  TRANSACTION); 

SUBPROGRAM; 

(**) 

(* - - - *) 

<*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  'PUSHES'  THE  TRANSACTION  DATA  ON  TO  THE  *) 

(*  DYNAMICALLY  ALLOCATED  STACK.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  POINTER  TO  THE  TRANSACTION  STACK  *) 

(*  DATA  I  THE  TRANSACTION  DATA  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  A  NODE  IS  ALLOCATED  BY  CALLING  THE  BUILT  IN  PASCAL  *) 

(*  PROCEDURE  'NEW'.  THE  TRANSACTION  DATA  IS  THEN  'PUSHED'  *) 

(*  ONTO  THE  STACK.  *) 

<*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

<*  $ CHANGE  CONTROL:  *) 

(*  •  *) 
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(*  %INCLUDE  SCRELCR  *) 

(**) 

PROCEDURE  SCRELCR (VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANSPTR); 


(**) 

(*— 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


SUBPROGRAM; 


^FUNCTION: 

THIS  ROUTINE  GATHERS  THE  DATA  NECESSARY  TO  CREATE  THE 
REAL  ENTITY  AND  PUSHES  THE  DATA  ON  THE  TRANSACTION 
STACK. 


^DESCRIPTION  OF  ARGUMENTS: 


NAME 

I/O 

DESCRIPTION 

IRC 

0 

THE  RETURN  CODE 

TRANS  STACK 

I/O 

THE  TRANSACTION  STACK 

$ COMMONS : 

REF 

INSIDE  I/O  INDICATES  IF  THE  EXIT  OPTION  OR 

THE  RETURN  OPTION  IS  CHOSEN  WITHIN 
ANOTHER  ROUTINE 

^ENVIRONMENT : 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 


^PROCESSING  DESCRIPTION: 

THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINE  CRREAL 
TO  DISPLAY  THE  PANEL.  THE  DATA  ENTERED  ON  THE  PANEL  IS 
VERIFIED  AND  IF  IT  IS  OK  IT  IS  PUSHED  ON  THE  TRANSACTION 
STACK.  OTHERWISE,  IF  THE  DATA  ENTERED  IS  INVALID  THE 
PANEL  IS  REDISPLAYED. 


^COMMENTS : 

$ CHANGE  CONTROL: 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  SCRELUP  *) 

(**) 

PROCEDURE  SCRELUP(VAR  IRC  :  RET_REC; 

VAR  REAL_KEY  :  ENTKEY; 

VAR  NUMBER_OF_USERS  :  INTEGER; 

VAR  DELETE_LIST  :  LISTKEY; 

VAR  NEW_KEYS_LIST  :  LISTKEY); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  UPDATES  THE  REAL  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  REALJKEY  I/O  KEY  OF  THE  ENTITY  TO  BE  UPDATED  *) 

(*  NUMBER_OF_USERS  I  NUMBER  OF  USERS  OF  THE  REAL  ENTITY  *) 

(*  DELETE_LIST  I/O  LIST  OF  ENTITIES  TO  BE  DELETED  *) 

(*  NEW_KEYS_LIST  I/O  LIST  OF  NEWLY  CREATED  ENTITIES  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  DISPLAYS  THE  PRECISION  OF  THE  REAL  ENTITY  AND  *) 

(*  ALLOWS  THE  USER  TO  CHANGE  THE  INFORMATION  IF  HE/SHE  SO  *) 

(*  DESIRES.  IF  A  CHANGE  IS  MADE  AND  THE  NUMBER  OF  USERS  OF  *) 

(*  THE  OLD  REAL  ENTITY  IS  ONE  OR  LESS  THEN  ITS  KEY  IS  PLACED  *) 

(*  ON  THE  DELETE  LIST.  AFTER  THE  NEW  REAL  ENTITY  IS  CREATED  *) 

(*  THIS  KEY  IS  PLACED  ON  THE  NEW  KEYS  LIST.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

<*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  SCREVIEW  *) 

(**) 

PROCEDURE  SCREVIEW(VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANSPTR) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  DETERMINES  THE  NEXT  MENU  TO  DISPLAY  FROM  THE  *) 

(*  EDIT  OPTION  CHOSEN.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  DEF  *) 

(*  INSIDE  I/O  INDICATES  IF  THE  EXIT  OPTION  HAS  *) 

(*  BEEN  CHOSEN  WITHIN  ANOTHER  CREATE  *) 

(*  PROCEDURE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  CALLS  THE  REVIEW  MENU  INTERFACE  ROUTINE  (MREVIEW)  AND  *) 

(*  PROCESSES  THE  DATA  RECIEVED  FROM  THE  MENU  EITHER  BY  *) 

(*  CALLING  THE  APPROPRIATE  ROUTINE  OR  EXITING  THE  PROCEDURE.  *) 

(*  *> 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  SCRPTM  *) 

(**) 

PROCEDURE  SCRPTM(VAR  IRC  :  RET_REC ; 

VAR  XREFFILE  :  TEXT); 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  DETERMINES  THE  REPORT  OPTION  SELECTED  AND  *) 

(*  CALLS  THE  ROUTINE  WHICH  GENERATES  THE  REPORT.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  XREFFILE  0  CROSS  REFERENCE  REPORT  FILE  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  CALL  THE  MENU  INTERFACE  ROUTINE  TO  DISPLAY  THE  REPORT  *) 

(*  MENU  (RPTMENU)  AND  THEN  CALL  THE  APPROPRIATE  ROUTINE  *) 

(*  TO  GENERATED  THE  REPORT.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  SCSETCR  *) 

(**) 

PROCEDURE  SCSETCR(VAR  IRC 

VAR  TRANS_STACK 
VAR  CONTEXT 

SUBPROGRAM; 

(**) 

(* - 

(* 

(* 

C* 

(* 

(* 

(* 

(* 


RET_REC ; 
TRANS PTR; 
T_CONTEXT) ; 


$ FUNCTION: 

THIS  ROUTINE  GATHERS  THE  DATA  NECESSARY  TO  CREATE  THE 
SET  ENTITY  AND  PUSHES  THE  DATA  ON  THE  TRANSACTION 
STACK. 


^DESCRIPTION  OF  ARGUMENTS: 


-*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 


(* 

(* 

(* 

NAME  I/O  DESCRIPTION 

*) 

*) 

*) 

IRC  0  THE  RETURN  CODE 

<* 

TRANS_STACK  I/O  THE  TRANSACTION  STACK 

*) 

<* 

CONTEXT  I  THE  CONTEXT  IN  WHICH  THE 

SET  IS  BEING 

*) 

(* 

CREATED 

*) 

(* 

*) 

(* 

^COMMONS : 

*) 

(* 

REF 

*) 

(* 

INSIDE  I/O  INDICATES  IF  THE  EXIT  OR 

RETURN  OPTION 

*) 

(* 

IS  CHOSEN  WITHIN  ANOTHER 

ROUTINE 

*) 

(* 

*) 

(* 

^ENVIRONMENT : 

*) 

(* 

LANGUAGE:  IBM  PASCAL 

*> 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

*) 

(* 

*) 

(* 

^EXECUTION  PROCEDURE: 

*) 

(* 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 

*) 

(* 

*) 

(* 

^PROCESSING  DESCRIPTION: 

*) 

(* 

THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINE  CRSET 

*) 

(* 

TO  DISPLAY  THE  PANEL.  THE  DATA  ENTERED  ON 

THE  PANEL  IS 

*) 

(* 

VERIFIED  AND  IF  IT  IS  OK  IT  IS  PUSHED  ON  THE  TRANSACTION 

*) 

(* 

STACK  OR  THE  APPROPRIATE  ACTION  IS  TAKEN. 

IF  ANY  OF  THE 

*) 

<* 

DATA  ENTERED  IS  INVALID  THEN  THE  PANEL  IS  REDISPLAYED 

*> 

<* 

WITH  AN  ERROR  MESSAGE. 

*) 

<* 

*) 

(* 

^COMMENTS : 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

*) 
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(*  %INCLUDE  SCSETUP  *) 

(**) 

PROCEDURE  SCSETUP(VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  SET_KEY  :  ENTKEY; 

VAR  NUMBER_OF_USERS  :  LISTKEY; 

VAR  DELETE_LIST  :  LISTKEY; 

VAR  NEW_KEYS_LIST  :  LISTKEY; 

VAR  CONTEXT  :  T_C0NTEXT) ; 

SUBPROGRAM; 

(**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  GATHERS  THE  DATA  TO  UPDATE  A  SET. 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 

(*  NAME  I/O  DESCRIPTION 

(*  IRC  0  RETURN  CODE 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK 

(*  SET_KEY  I/O  KEY  OF  THE  SET  TO  BE  UPDATED 

(*  NUMBER_OF_USERS  I/O  THE  NUMBER  OF  USERS  OF  THE  LIST 

(*  DELETEJLIST  I/O  LIST  OF  ENTITIES  TO  BE  DELETED 

(*  NEW_KEYS_LIST  I/O  LIST  OF  NEWLY  CREATED  ENTITIES 

(*  CONTEXT  I  THE  CONTEXT  IN  WHICH  THE  SET  IS  BEING 

(*  UPDATED 

(* 

(*  $ COMMONS: 

(*  NONE 

(* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 

(* 

(*  • ^PROCESSING  DESCRIPTION: 

(*  THE  CURRENT  SET  DATA  IS  DISPLAYED  ON  THE  UPSET  PANEL. 

(*  THE  DATA  CAN  THEN  BE  UPDATED  BY  THE  USER. 

<* 

(*  $ COMMENTS : 

(* 

(*  ^CHANGE  CONTROL: 

(* 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*> 

*> 

*> 

*) 

*) 

*> 

*) 

*) 

*) 

*) 
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(*  ^INCLUDE  SCSRTPOS  *) 

(**) 

PROCEDURE  SCSRTPOS(CONST  CURRENT  :  ENTBLOCK; 

CONST  NEXT  :  ENTBLOCK; 

VAR  FLIP  :  BOOLEAN; 

VAR  RRC  :  EXT_RET_CODE; 

VAR  PROC  :  ROUTINE); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  IS  USED  BY  THE  MAS  MALSRT  ROUTINE  TO  SORT  *) 

(*  CONSTITUENT  LIST  ATTRIBUTES  BY  POSITION  NUMBER  *) 

<*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  ENTITY_K£Y  I  KEY  TO  THE  ENTITY  *) 

(*  ADB  0  DATA  STORED  IN  THE  ADB  *) 

(*  DATA  I/O  THE  USER  DEFINED  DATA  STRUCTURE  USED  *) 

(*  TO  PASS  DATA  INTO  THIS  PROCEDURE  AND  *) 

(*  TO  GET  THE  DESIRED  OUTPUT  FROM  THE  *) 

(*  PROCEDURE  *) 

(*  RRC  0  EXTERNAL  RETURN  CODE  *) 

(*  =0  OK  *) 

(*  >=  10  ERROR  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^'PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  IS  CALLED  BY  THE  MAS  EXECUTE  ROUTINES,  *) 

(*  MAKXEQ  AND  MAEXEQ.  THE  LIST  IS  SEARCHED  FOR  IDENTICAL  *) 

(*  DATA  AND  IF  IT  IS  FOUND  THE  ENTITY'S  KEY  IS,  RETURNED  TO  *) 

(*  THE  CALLING  PROCEDURE  AS  WELL  A  FLAG  INDICATING  THAT  THE  *) 

(*  KEY  RETURNED  IS  THE  CORRECT  ONE.  *) 

<*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 
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(*  ^INCLUDE  SCSTCUP  *) 

(**) 

PROCEDURE  SCSTCUP(VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  STRUCTURE_KEY  :  ENTKEY; 

VAR  DELETE_LIST  :  LISTKEY; 

VAR  NEW_KEYS_LIST  :  LISTKEY; 

VAR  CONTEXT  :  T_CONTEXT ) ; 

SUBPROGRAM; 

(**) 

<* - - - *) 

(*  *> 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GATHERS  THE  DATA  TO  UPDATE  THE  STRUCTURE  *) 

(*  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  TRANS _STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK  *) 

(*  STRUCTUREJCEY  I/O  KEY  OF  THE  ENTITY  TO  BE  UPDATED  *) 

(*  DELETE_LIST  I/O  LIST  OF  ENTITIES  TO  BE  DELETED  *) 

(*  NEW_KEYS_LIST  I/O  LIST  OF  NEWLY  CREATED  ENTITIES  *) 

(*  CONTEXT  I  THE  CONTEXT  IN  WHICH  THE  DEFINED  TYPE  *) 

(*  IS  BEING  CREATED.  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

<*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  UPDATES  THE  FIELDS  IN  A  STRUCTURE.  FIELDS  *) 

(*  CAN  BE  ADDED,  REMOVED,  REVIEWED,  AND  UPDATED.  IF  ANY  *) 

(*  CHANGES  WERE  MADE  TO  THE  STRUCTURE  ENTITY'S  CONSTITUENTS  *) 

(*  THE  OLD  STRUCTURE  ENTITY'S  KEY  IS  PLACED 'ON  THE  DELETE  LIST  *) 

(*  AND  A  NEW  STRUCTURE  ENTITY  IS  MODELED  AND  ITS  KEY  IS  PLACED  *) 

(*  ON  THE  NEW  KEYS  LIST.  *) 

(*  *) 

(*  $ COMMENTS:  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 
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(*  %INCLUDE  SCSTGCR  *) 

(**) 

PROCEDURE  SCSTGCR(VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANSPTR) ; 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GATHERS  THE  DATA  NECESSARY  TO  CREATE  THE  *) 

(*  STRING  ENTITY  AND  PUSHES  THE  DATA  ON  THE  TRANSACTION  *) 

(*  STACK.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  THE  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  THE  TRANSACTION  STACK  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  REF  *) 

(*  INSIDE  I/O  INDICATES  IF  THE  EXIT  OPTION  OR  *) 

(*  THE  RETURN  OPTION  IS  CHOSEN  WITHIN  *) 

(*  ANOTHER  ROUTINE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

<*  *> 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINE  CRSTRING  *) 

(*  TO  DISPLAY  THE  PANEL.  THE  DATA  E.ITERED  ON  THE  PANEL  IS  *) 

(*  VERIFIED  AND  IF  IT  IS  OK  IT  IS  PUSHED  ON  THE  TRANSACTION  *) 

(*  STACK.  OTHERWISE,  IF  THE  DATA  ENTERED  IS  INVALID  THE  *) 

(*  PANEL  IS  REDISPLAYED.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

<*  *) 

(*  $ CHANGE  CONTROL:  *) 

<*  *) 
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(*  %INCLUDE  SCSTGUP  *) 

(**) 

PROCEDURE  SCSTGUP(VAR  IRC  :  RET_REC; 

VAR  STRING_KEY  :  ENTKEY ; 

VAR  NUMBER_OF_USERS  :  INTEGER; 
VAR  DELETE_LIST  :  LISTKEY; 

VAR  NEW_KEYS_LIST  :  LISTKEY); 

SUBPROGRAM; 


*) 


(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  UPDATES  THE  STRING  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  STRING  KEY  I/O  KEY  OF  THE  ENTITY  TO  BE  UPDATED  *) 

(*  NUMBER_OF_USERS  I  NUMBER  OF  USERS  OF  THE  STRING  ENTITY  *) 

(*  DELETE_LIST  I/O  LIST  OF  ENTITIES  TO  BE  DELETED  *) 

(*  NEW_KEY S_LI ST  I/O  LIST  OF  NEWLY  CREATED  ENTITIES  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  DISPLAYS  THE  LENGTH  OF  THE  STRING  ENTITY  IN  *) 

(*  BYTES  AND  ALLOWS  THE  USER  TO  CHANGE  THE  INFORMATION  IF  HE/  *) 

(*  SHE  SO  DESIRES.  IF  A  CHANGE  IS  MADE  AND  THE  NUMBER  OF  *) 

(*  USERS  OF  THE  OLD  STRING  ENTITY  IS  ONE  OR  LESS  THEN  ITS  KEY  *) 

(*  IS  PLACED  ON  THE  DELETE  LIST.  AFTER  THE  NEW  STRING  ENTITY  *) 

(*  IS  CREATED  ITS  KEY  IS  PLACED  ON  THE  NEW  KEYS  LIST.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  SCSUBCR  *) 

(**) 

PROCEDURE  SCSUBCR(VAR  IRC  :  RET_REC ; 

VAR  TRANS_STACK  :  TRANSPTR) ; 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GATHERS  THE  DATA  NEEDED  TO  MODEL  THE  *) 

(*  SUBSCHEMA  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  INTERNAL  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  REF  *) 

(*  INSIDE  I/O  INDICATES  IF  THE  EXIT  OR  RETURN  OPTION  *) 

(*  HAS  BEEN  CHOSEN  WITHIN  ANOTHER  ROUTINE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THE  MENU  INTERFACE  ROUTINE  (CRSUBSCM)  IS  CALLED  TO  DISPLAY  *) 

(*  THE  CREATE  SUBSCHEMA  PANEL.  THE  DATA  GATHERED  IS  VERIFIED  *) 

(*  AND  IF  IT  IS  VALID  IT  IS  PUSHED  ON  TO  THE  TRANSACTION  *) 

(*  STACK  OR  THE  APPROPRIATE  ACTION  IS  TAKEN.  IF  ANY  OF  THE  *) 

(*  DATA  IS  INVALID  THE  PANEL  IS  REDISPLAYED  WITH  AN  ERROR  *) 

(*  MESSAGE.  THIS  PANEL  CONTINUES  TO  BE  DISPLAYED  UNTIL  EXIT  *) 

(*  OR  NO  MORE  MEMBERS  IS  CHOSEN.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  SCSUBUP  *) 

(**) 

PROCEDURE  SCSUBUP(VAR  IRC  :  RET_REC; 

VAR  SUBSCHEMA  JCEY  :  ENTKEY) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GATHERS  THE  DATA  TO  UPDATE  THE  SUBSCHEMA  *) 

(*  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  SUBSCHEMA_KEY  I  KEY  OF  THE  ENTITY  TO  BE  UPDATED  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINES  (UPSUB1  AND  *) 

(*  UPSUB2)  WHICH  DISPLAY  THE  DATA  DESCRIBING  THE  SUBSCHEMA.  *) 

(*  THE  UPDATE  SUBSCHEMA  OPTIONS  INCLUDE  :  *) 

(*  CHANGE  THE  SUBSCHEMA  NAME,  *) 

(*  UPDATE  THE  CONSTITUENT  LIST  BY  ADDING/  *) 

(*  REMOVING  ELEMENTS,  *) 

(*  REVIEW  A  CONSTITUENT,  *) 

(*  DELETE  THE  SUBSCHEMA,  *) 

(*  SAVE  THE  CHANGES  MADE,  *) 

(*  •  RETURN  AND  EXIT.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  SCSUPCR  *) 
(**) 

PROCEDURE  SCSUPCR (VAR 
VAR 
VAR 
VAR 
VAR 

SUBPROGRAM; 

(**> 


IRC 

TRANS_STACK 

CREATE_ONLY 

BUILD 

SUPERTYPE  KEY 


RET_REC ; 
TRANS PTR; 
BOOLEAN; 
BOOLEAN; 
ENTKEY); 


(*- 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

<* 

<* 

<* 

<* 


^FUNCTION: 

THIS  ROUTINE  GATHERS  THE  DATA  NECESSARY  TO  MODEL  THE 
SUPERTYPE  ENTITY. 


^DESCRIPTION  OF  ARGUMENTS: 


NAME 


I/O  DESCRIPTION 


IRC 

TRANS_STACK 

CREATE_ONLY 


0 

I/O 

I 


RETURN  CODE 

POINTS  TO  THE  TRANSACTION  STACK 
INDICATES  IF  SUPERTYPE  IS  TO  BE  ONLY 
CREATED  OR  IF  ONE  ALREADY  EXISTING  CAN 
BE  REFERENCED. 


^COMMONS : 

REF 

INSIDE  I/O  INDICATES  IF  THE  EXIT  OR  RETURN  OPTION 

IS  CHOSEN  WITHIN  ANOTHER  ROUTINE. 


^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 


^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 


^PROCESSING  DESCRIPTION: 

THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINE  (CRSUPTYP) 
WHICH  DISPLAYS  THE  CREATE  SUPERTYPE  PANEL.  THE  NAME  IS 
CHECKED  FOR  US  CHECKED  FOR  UNIQUENESS.  IF  THEY  ARE  UNIQUE 
THEN  THE  DATA  IS  PUSHED  ONTO  THE  TRANSACTION  STACK  AND 
THE  ROUTINE  (SCFLDCR)  IS  CALLED  TO  ENTER  THE  ENTITY'S 
FIELDS.  AFTER  ALL  OF  THE  FIELDS  HAVE  BEEN  ENTERED  THE 
TRANSACTION  PROCESSING  ROUTINE  IS  CALLED  TO  MODEL  THE 
ENTITY. 

^COMMENTS : 

$ CHANGE  CONTROL: 


■*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*> 

*> 

*) 

*) 

*) 

*) 

*) 


3-547 


Cl  PS560240032U 
April  1990 


(*  %INCLUDE  SCSUPUP  *) 

(**) 

PROCEDURE  SCSUPUP(VAR  IRC  :  RET_REC ; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  SUP_KEY  :  ENTKEY; 

VAR  REMOVE_SUPERTYPE  :  BOOLEAN); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  UPDATES  THE  SUPERTYPE  ENTITY.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK  *) 

(*  SUPJCEY  I/O  KEY  OF  THE  ENTITY  TO  BE  UPDATED  *) 

(*  REMOVE_SUPERTYPE  I/O  INDICATES  IF  SUPERTYPE  CAN  BE  REMOVED  *) 

(*  OR  IF  ONLY  THE  REFERENCE  TO  THE  SUPER-  *) 

(*  TYPE  CAN  BE  REMOVED.  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

C*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  CALLS  THE  MENU  INTERFACE  ROUTINES  TO  DISPLAY  *) 

(*  THE  DATA  ABOUT  THE  SUPERTYPE.  THE  UPDATE  SUPERTYPE  OPTIONS  *) 

(*  INCLUDE  THE  FOLLOWING:  *) 

(*  CHANGE  THE  SUPERTYPE  NAME,  *) 

(*  UPDATE  THE  SUPERTYPE'S  CONSTITUENTS  (FIELDS)  BY  *) 

(*  ADDING  FIELDS,  REMOVING  FIELDS  OR  UPDATING  FIELDS,  *) 

(*  REVIEW  A  FIELD,  *) 

(*  DELETE  THE  SUPERTYPE,  *) 

(*  SAVE  THE  CHANGES  MADE,  *) 

(*  RETURN  OR  EXIT.  *) 
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(*  IF  SAVE  THE  CHANGES  WAS  SELECTED  THE  SUPERTYPE  IS  UPDATED  *) 
(*  AND  THE  SUPERTYPES  ON  THE  DELETE  LIST  WILL  BE  DELETED  IF  *) 
(*  POSSIBLE.  IF  RETURN  OR  EXIT  IS  SELECTED  THE  SUPERTYPES  ON  *) 
(*  THE  NEW  KEYS  LIST  WILL  BE  DELETED  IF  POSSIBLE.  *) 
(*  *) 
(*  ^COMMENTS:  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 
(*  *) 
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(*  ^INCLUDE  SCTRSPR  *) 

(**) 

PROCEDURE  SCTRSPR(VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANS PTR) ; 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  BEGINS  THE  PROCESSING  OF  THE  TRANSACTION  *) 

(*  STACK.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  REF  *) 

(*  CURRENT_LIST  I/O  POINTS  TO  THE  LIST  OF  KEYS  *) 

(*  CURRENTLY  IN  USE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  CALLS  SCPOPTR  TO  POP  THE  TRANSACTION  STACK.  *) 

(*  THEN  EACH  TRANSACTION  IS  PROCESSED  ACCORDING  TO  ITS  TYPE  *) 

(*  BY  CALLING  THE  APPROPRIATE  ROUTINE  TO  MODEL  THE  ENTITIES.  *) 

(*  *) 

(*  ^COMMENTS :  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  REVISED:  JANUARY  1988  C.  H.  MOHME  DBMA  *) 

(*  MODIFIED  TO  INCORPORATE  THE  STRUCTURE  DATA  TYPE  *) 

(*  *) 

(*  REVISED:  10/09/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  TO  ALLOW  FOR  THE  CREATION  OF  A  DEFINED  TYPE  FROM  THE  *) 

(*  MAIN  CREATE  MENU.  *) 

(*  *) 


3-550 


Cl  PS560240032U 
April  1890 


(*  REVISED:  09/28/87  G.  H.  MOHME  DBMA  *) 

(*  INCORPORATED  THE  SUPERTYPE  DATA  TYPE.  *) 

(*  *) 

(*  ORIGINATED:  02/04/86  L.  J.  BEHAN  FRMI  *) 

•<*  *) 

(* - - - *) 

(*  *) 

(*END - ' - *) 

(*  END  %INCLUDE  SCTRSPR  *) 
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(*  %INCLUBE  SCTYPIN  *) 
(**) 

PROCEDURE  SCTYPIN(VAR 
VAR 
VAR 


IRC 

INCLD 

SUBSCHEMA  KEY 


RET_REC ; 
TEXT; 
ENTKEY) ; 


(**) 

(*— 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

c* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

c* 

(* 

(* 

(* 


SUBPROGRAM; 


■*> 

*) 


$ FUNCTION:  *) 

THIS  ROUTINE  WRITES  THE  DEFINED  TYPE  DECLARATIONS  TO  THE  *) 
PASCAL  INCLUDE  FILE.  *) 

*) 

^DESCRIPTION  OF  ARGUMENTS:  *) 

NAME  I/O  DESCRIPTION  *) 

IRC  I/O  RETURN  CODE  *) 

INCLD  I  THE  FILE  NAME  *) 

SUBSCHEMA_KEY  I  THE  KEY  TO  THE  SUBSCHEMA  *) 

*) 

$ COMMONS:  *) 

NONE  *) 

*) 

^ENVIRONMENT :  *) 

LANGUAGE:  IBM  PASCAL  *) 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

*) 

^EXECUTION  PROCEDURE:  *) 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

*) 

^PROCESSING  DESCRIPTION:  *) 

WRITE  A  DESCRIPTION  OF  THE  BASIC  TYPES  AND  HOW  THEY  ARE  *) 

IMPLEMENTED  *) 

WRITE  THE  DEFINED  TYPES  HEADING  TO  THE  FILE  *) 

WRITE  TYPE  TO  THE  FILE  *) 

MAKE  AN  INCLUSIVE  LIST  OF  DEFINED  TYPES  WITHIN  THE  *) 

SUBSCHEMA  *) 

DELETE  ANY  DUPLICATES  ON  THE  LIST  OF  DEFINED  TYPES  *) 

SET  THE  LIST  OF  DEFINED  TYPES  TO  BE  READ  FORWARD  *) 

CONTINUE  TO  READ  ITEMS  UNTIL  THE  END  OF  LIST  IS  ENCOUNTERED  *) 
GET  THE  KEY  TO  THE  NEXT  DEFINED  TYPE  IN  THE  LIST  *) 

GET  THIS  DEFINED  TYPE'S  ADB  *) 

GET  THE  DEFINED  TYPE'S  CONSTITUENT  *) 

GET  THE  CONSTITUENT'S  ADB  *) 

WRITE  TO  THE  FILE  T_< ADB . DEF_TYP_NAME >  =  *) 

CALL  THE  ROUTINE  TO  WRITE  OUT  THE  PRIMITIVE  TYPES  OF  *) 

INTEGER  ■  *) 
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(* 

REAL 

*) 

(* 

STRING 

*) 

(* 

LOGICAL 

*) 

(* 

ARRAY 

*) 

(* 

DEFINED  TYPE 

*) 

(* 

ENUMERATION 

*) 

(* 

STRUCTURE 

*) 

(* 

POINTER 

*) 

<* 

END 

*) 

(* 

*) 

(* 

$ COMMENTS : 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

*) 

(* 

REVISED:  JANUARY  1988  C.  H.  MOHME 

DBMA 

*) 

(* 

MODIFIED  TO  INCORPORATE  THE  STRUCTURE  DATA  TYPE 

*) 

(* 

*) 

(* 

REVISED:  08/13/87  C.  H.  MOHME 

DBMA 

*) 

(* 

CORRECTED  CHECKING  OF  MAS  RETURN  CODE. 

*) 

(* 

*) 

(* 

REVISED:  07/30/87  C.  H.  MOHME 

DBMA 

*) 

(* 

A  STRUCTURE  IS  NO  LONGER  IMPLEMENTED  AS  A  RECORD 

TYPE. 

*) 

(* 

*) 

(* 

ORIGINATED:  10/23/86  L.  J.  BEHAN 

DBMA 

*) 

(* 

*) 

(*--- 

— *) 

(* 

*) 

(*END - 

— 

- *) 

(*  END  %INCLUDE  SGTYPIN  *) 
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(*  %INCLUDE  SCTYPUP  *) 

(**) 

PROCEDURE  SCTYPUP (VAR  IRC  :  RET_REC ; 

VAR  TRANS_STACK  :  TRANSPTR; 

VAR  CNST_KEY  :  ENTKEY ; 

VAR  CREATE  :  BOOLEAN; 

VAR  NEWTYPE  :  ENTITY_TYPE; 

VAR  DELETE_LIST  :  LISTKEY; 

VAR  NEW_KEYS_LIST  :  LISTKEY; 

VAR  CONTEXT  :  T_C0NTEXT); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  UPDATES  THE  DEFINED  TYPE,  ARRAY,  OR  FIELD  *) 

(*  ENTITY'S  TYPE.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK  *) 

(*  CNSTJCEY  I/O  KEY  TO  THE  TYPE  TO  BE  UPDATED  *) 

(*  CREATE  I  INDICATES  IF  A  NEW  ENTITY  IS  TO  BE  MADE  *) 

(*  NEWTYPE  I  ENTITY  TYPE  TO  UPDATE  *) 

(*  DELETE_LIST  I/O  KEY  TO  LIST  OF  ENTITIES  TO  BE  DELETED  *) 

(*  IF  THE  OPTION  SAVE  THE  CHANGED  IS  CHOSEN  *) 

(*  NEW_KEYS_LIST  I/O  KEY  TO  LIST  OF  ENTITIES  CREATED  DURING  *) 

(*  AN  UPDATE  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  CONTEXT  I  THE  CONTEXT  IN  WHICH  THE  DEFINED  TYPE  *) 

(*  IS  BEING  CREATED  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  DETERMINES  IF  A  NEW  ENTITY  IS  TO  BE  CREATED  *) 

(*  OR  IF  THE  OLD  ENTITY  SHOULD  BE  UPDATED.  THEN  IT  CALLS  *) 

(*  THE  ROUTINE  ACCORDING  TO  THE  ENTITY  TYPE  ENTERED.  *) 
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(*  *) 

(*  $ COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  REVISED:  JANUARY  1988  C.  H.  MOHME  DBMA  *) 

(*  MODIFIED  TO  INCORPORATE  THE  STRUCTURE  DATA  TYPE  *) 

(*  '  *) 
(*  REVISED:  10/09/87  C.  H.  MOHME  DBMA  *) 

(*  ADDED  PARAMETER  TO  SCDEFCR  CALL.  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  ADDED  LIST  AND  SET.  NOTE:  THE  LIST  AND  SET  DATA  TYPES  ARE  *) 

(*  IMPLEMENTED  IN  THE  SOFTWARE  AS  AN  ARRAY.  A  FIELD  WAS  ADDED  *) 

(*  TO  THE  ARP4Y  ADB  TO  SPECIFY  WHETHER  THE  ARRAY  IS  A  CONCEPTUAL  *) 

(*  ARRAY,  LIST,  OR  SET.  *) 

(*  *) 

(*  ORIGINATED:  08/05/86  L.  J.  BEHAN  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  SCTYPUP  *) 


3-555 


Cl  PS560240032U 
April  1990 


_  ^ 


(*  %INCLUDE  SCUNIQUE  *) 


(**) 

PROCEDURE  SCUNIQUE (CONST  ENTITY_KEY  :  ENTKEY; 

VAR  ADB  :  ENTBLOCK; 

VAR  DATA  :  BLKDATA ; 

VAR  RRC  :  INTEGER); 

SUBPROGRAM; 

(**) 


(*- 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


^FUNCTION: 

THIS  ROUTINE  VERIFIES  THE  UNIQUENESS  OF  NAMES  WITHIN  THE 
SCHEMA  FOR  THE  SUBSCHEMA,  CLASS,  ENTITY,  GLOBAL  FIELD, 
FIELD,  ENUMERITEM,  AND  DEFINED  TYPE  ENTITIES  AS  WELL  AS 
THE  USER  DEFINED  KIND  NUMBERS  FOR  CLASSES  AND  ENTITIES. 

^DESCRIPTION  OF  ARGUMENTS: 

NAME  I/O  DESCRIPTION 


ENTITY _KEY 

ADB 

DATA 


RRC 


I  THE  KEY  TO  THE  ENTITY 

0  THE  ADB  INFORMATION 

I/O  THE  USER  DEFINED  DATA  STRUCTURE  USED 
TO  PASS  DATA  INTO  THIS  PROCEDURE  AND 
TO  GET  THE  DESIRED  OUTPUT  FROM  THIS 
PROCEDURE 

0  THE  ROUTINE  RETURN  CODE 


^COMMONS : 
NONE 


^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 


^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 


^PROCESSING  DESCRIPTION: 

THIS  ROUTINE  IS  EXECUTED  BY  CALLING  MAKXEQ  FOR  A  GIVEN 
KIND.  THE  NAMES  AND  USER  DEFINED  KIND  NUMBERS  ARE 
COMPARED  TO  ONE  ANOTHER  TO  VERIFY  THAT  THE  DATA  ENTERED 
IS  UNIQUE.  THE  DATA  STRUCTURE  BLKDATA  CONTAINS  THE 
INFORMATION  WHICH  INDICATES  THE  UNIQUENESS. 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 


^COMMENTS : 

$  CHANGE  CONTROL: 


3-556 


Cl  PS560240032U 
April  1990 


(*  %INCLUDE  SGUNQEST  *) 

(**) 

PROCEDURE  SCUNQEST(VAR  IRC  :  RET_REC; 

CONST  ENTJCIND  :  INTEGER; 

VAR  UNIQUE_NAME  :  T_NAME; 

VAR  UNIQUE  JfUMBER  :  INTEGER; 
VAR  FOUND  :  MATCH); 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  CALLS  MAKXEQ  TO  EXECUTE  THE  PROCEDURE  SCUNIQUE  *) 

(*  WHICH  VERIFIES  THE  UNIQUENESS  OF  NAMES  WITHIN  THE  SCHEMA  *) 

(*  FOR  THE  SUBSCHEMA,  CLASS,  ENTITY,  GLOBAL  FIELD,  FIELD,  *) 

(*  ENUMERITEM,  AND  DEFINED  TYPE  ENTITIES  AS  WELL  AS  THE  USER  *) 

(*  DEFINED  KIND  NUMBERS  FOR  CLASSES  AND  ENTITIES.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  ENTJCIND  I  THE  ENTITY  KIND  NUMBER  *) 

(*  UNIQUE_NAME  I  THE  NAME  TO  BE  VERIFIED  FOR  UNIQUENESS  *) 

(*  UNIQUE_NUMBER  I  THE  NUMBER  TO  BE  VERIFIED  FOR  UNIQUENESS  *) 

(*  FOUND  0  A  RECORD  WHICH  INDICATES  WHETHER  OR  *) 

(*  NOT  A  MATCH  TO  A  NAME  OR  KIND  NUMBER  *) 

(*  HAS  BEEN  FOUND  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

<*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  CALLS  MAKXEQ  TO  EXECUTE  THE  PROCEDURE  *) 

(*  SCUNIQUE  WHICH  DOES  THE  ACTUAL  COMPARISON  FOR  UNIQUENESS.  *) 

(*  THIS  CONTINUES  UNTIL  A  MATCH  IS  FOUND  OR  ALL  THE  ENTITIES  *) 

(*  HAVE  BEEN  CHECKED.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  '  *) 
(*  $ CHANGE  CONTROL:  *) 
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(*  %INCLUDE 
(**) 

PROCEDURE 


SCUNQPND  *) 

SCUNQPND(VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANSPTR; 
VAR  UNIQUE_NAME  :  T_NAME; 

VAR  UNIQUE_NUMBER  :  INTEGER; 
VAR  TRANSTYPE  :  TRANSJTYPE; 
VAR  FLDTYP  :  T_FIELDTYPE; 

VAR  FOUND  :  MATCH); 


(**) 
(* — 
(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(*  < 
(* 

(* 

(* 

<* 

<* 

(* 

(* 

(* 


SUBPROGRAM; 


^FUNCTION: 

THIS  ROUTINE  VERIFIES  THE  UNIQUENESS  OF  NAMES  AND  USER 
DEFINED  KIND  NUMBERS  FOR  CLASSES  AND  ENTITIES,  BY  SEARCHING 
THE  TRANSACTION  STACK  FOR  THE  CLASS,  ENTITY,  FIELD, 
ENUMERITEM,  AND  DEFINED  TYPE  ENTITIES. 

^DESCRIPTION  OF  ARGUMENTS: 

NAME  I/O  DESCRIPTION 


IRC 

TRANS_STACK 

UNIQUE_NAME 

UNIQUE_NUMBER 

TRANSTYPE 

FLDTYP 

FOUND 


$ COMMONS : 

NONE 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 
^PROCESSING  DESCRIPTION: 

THIS  ROUTINE  SEARCHES  THROUGH  THE  TRANSACTION  STACK  AND 
COMPARES  THE  NAME  ENTERED  TO  THOSE  TRANSACTIONS  WHICH 
MUST  HAVE  UNIQUE  NAMES  WITHIN  THE  SCHEMA.  FIELD  ENTITY 
NAMES  ARE  CHECKED  FOR  UNIQUENESS  AMONG  THOSE  FIELDS  WITHIN 


0  RETURN  CODE 

I  POINTER  TO  THE  TRANSACTION  STACK 
I  THE  NAME  TO  BE  VERIFIED  FOR  UNIQUENESS 
I  THE  NUMBER  TO  BE  VERIFIED  FOR  UNIQUENESS 
I  INDICATES  THE  TYPE  OF  TRANSACTION 
I  INDICATES  FOR  THE  FIELD  ENTITY  WHAT  TYPE 
OF  FIELD  IT  IS 

0  A  RECORD  WHICH  INDICATES  WHETHER  OR  NOT 
A  MATCH  BEEN  FOUND 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(* 

<* 

(* 

(* 

(* 

(* 

(* 


THE  E«Tm  BEING  CREATED.  THIS  CONTINUES  UNTIL  A  MATCH  TS 
FOUND  OR  THE  END  OF  THE  STACK  IS  ENCOUNTERED 


^COMMENTS : 


^CHANGE  CONTROL: 


*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  SCUPDATE  *) 
(**) 


PROCEDURE  SCUPDATE(VAR  IRC  :  RET_REC; 

VAR  TRANS_STACK  :  TRANS PTR ) ; 

SUBPROGRAM; 

<**) 

- - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  DETERMINES  THE  NEXT  MENU  TO  DISPLAY  FROM  THE 

(*  UPDATE  OPTION  CHOSEN. 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 

(*  NAME  I/O  DESCRIPTION 


IRC  0  RETURN  CODE 

(*  TRANS_STACK  I/O  POINTS  TO  THE  TRANSACTION  STACK 

(* 

(*  $ COMMONS : 

(*  DEF 


(* 

<* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


INSIDE  I/O  INDICATES  IF  THE  EXIT  OPTION  HAS 
BEEN  CHOSEN  WITHIN  ANOTHER  CREATE 
PROCEDURE 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 


$ EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 


^PROCESSING  DESCRIPTION: 

UPDATE  INTERFACE  ROUTINE  (MUPDATE)  and 
PROCESSES  THE  DATA  RECIEVED  FROM  THE  MENU  EITHER  BY 
CALLING  THE  APPROPRIATE  ROUTINE  OR  EXITING  THE  PROCEDURE. 

$ COMMENTS : 


SCHANGE  CONTROL: 


--*) 

*) 

*) 

*) 

*) 

*> 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  SORTKIND  *) 

(**) 

PROCEDURE  SORTKIND (CONST  CURRENT 

CONST  NEXT 
VAR  FLIP 
VAR  RRC 
VAR  PROC 


SUBPROGRAM; 

(**) 


ENTBLOCK; 
ENTBLOCK; 
BOOLEAN; 
EXT_RET_CODE ; 
ROUTINE); 


(* - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  IS  THE  ORDER  FUNCTION  CALLED  BY  MALSRT 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 


(* 

(* 

(* 

NAME 

I/O 

DESCRIPTION 

CURRENT 

I 

THE  ADB  OF  THE  CURRENT  ENTITY 

(* 

NEXT 

I 

THE  ADB  OF  THE  NEXT  ENTITY 

(* 

FLIP 

0 

INDICATES  IF  THE  ENTITIES  SHOULD  BE 

<* 

FLIPPED 

(* 

RRC 

0 

THE  ROUTINE'S  RETURN  CODE 

(* 

=  0  OK 

(* 

<>  0  ERROR 

(* 

XRC 

0 

EXTERNAL  RETURN  CODE  FROM  MAS 

(* 

=  0  OK 

(* 

>=  10  ERROR 

(* 

<* 

^COMMONS : 

<* 

NONE 

(* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(*  THIS  ROUTINE  IS  CALLED  BY  THE  MAS  ROUTINE  MALSRT.  THE 

(*  TWO  ENTITIES  ARE  COMPARED  AND  IF  THEY  ARE  OUT  OF  ALPHA- 

(*  BETICAL  ORDER  THE  FLIP  FLAG  IS  SET  TO  TRUE  OTHERWISE  THE 

(*  FLAG  REMAINS  FALSE.  IF  THE  FLAG  IS  TRUE  THE  ENTITIES  ARE 

(*  SWAPPED  OTHERWISE  THEY  ARE  NOT. 

(* 

(*  ^COMMENTS: 

(* 


•*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  | CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  3/06/87  M.  H.  CHOI  DBMA  *) 

(*  *) 

<* - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  SORTKIND  *) 
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(*  %INCLUDE  SORTNAME  *) 

(**) 

PROCEDURE  SORTNAME (CONST  CURRENT  :  ENTBLOCK; 

CONST  NEXT  :  ENTBLOCK; 

VAR  FLIP  :  BOOLEAN; 

VAR  RRC  :  EXT_RET_CODE ; 

VAR  PROC  :  ROUTINE); 

SUBPROGRAM;  •  ' 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  IS  THE  ORDER  FUNCTION  CALLED  BY  MALSRT  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  CURRENT  I  THE  ADB  OF  THE  CURRENT  ENTITY  *) 

(*  NEXT  I  THE  ADB  OF  THE  NEXT  ENTITY  *) 

(*  FLIP  0  INDICATES  IF  THE  ENTITIES  SHOULD  BE  *) 

(*  FLIPPED  *) 

(*  RRC  0  THE  ROUTINE’S  RETURN  CODE  *) 

(*  =  0  OK  *) 

(*  <>  0  ERROR  *) 

(*  XRC  0  EXTERNAL  RETURN  CODE  FROM  MAS  *) 

(*  =  0  OK  *) 

(*  >=10  ERROR  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

<*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  IS  CALLED  BY  THE  MAS  ROUTINE  MALSRT.  THE  *) 

(*  TWO  ENTITIES  ARE  COMPARED  AND  IF  THEY  ARE  OUT  OF  ALPHA-  *) 

(*  BETICAL  ORDER  THE  FLIP  FLAG  IS  SET  TO  TRUE  OTHERWISE  THE  *) 

(*  FLAG  REMAINS  FALSE.  IF  THE  FLAG  IS  TRUE  THE  ENTITIES  ARE  *) 

(*  SWAPPED  OTHERWISE  THEY  ARE  NOT.  *) 

(*  *) 

(*  $ COMMENTS:  *) 

(*  -  *) 
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(*  $ CHANGE  CONTROL:  *) 

C*  *) 

(*  ORIGINATED:  3/10/87  M.  H.  CHOI  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  ^INCLUDE  SORTNAME  *) 
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(*  %INCLUDE  UPARRAY  *) 

(**) 

PROCEDURE  UPARRAY (VAR  MESS  :  MESSAGE; 

VAR  LBND  :  CHAR8; 

VAR  HBND  :  CHAR8 ; 

VAR  ATYPE  :  ENTITYJTYPE; 

VAR  ULBD  :  CHAR8 ; 

VAR  UHBD  :  CHAR8,; 

VAR  UTYPE  :  ENTITY_TYPE; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  CONTEXT  :  T_C0NTEXT ; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  UPDATE  ARRAY  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  LBND  I  THE  LOWER  BOUND  OF  THE  ARRAY  *) 

(*  HBND  I  THE  UPPER  BOUND  OF  THE  ARRAY  *) 

(*  ATYPE  I  THE  ARRAY  TYPE  *) 

(*  ULBD  0  THE  UPDATED  LOWER  BOUND  OF  THE  ARRAY  *) 

(*  UHBD  0  THE  UPDATED  HIGHER  BOUND  OF  THE  ARRAY  *) 

(*  UTYPE  0  THE  UPDATED  ARRAY  TYPE  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  CONTEXT  I  THE  CONTEXT  IN  WHICH  THE  ARRAY  IS  BEING  *) 

(*  UPDATED  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 
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(* 

(* 

c* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


^EXECUTION  PROCEDURE: 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

^PROCESSING  DESCRIPTION: 

DISPLAY  THE  UPDATE  ARRAY  PANEL  (UPARRAY)  BY  MAKING  ISPLNK 
CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED 
TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  GATHERED 
FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PROCEDURE. 

^COMMENTS : 

NONE 


$ CHANGE  CONTROL: 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  UPCLASS1  *) 

(**) 

PROCEDURE  UPCLASS1(VAR  MESS  :  MESSAGE; 

VAR  NAME  :  T_NAME; 

VAR  KNUM  :  CHAR8 ; 

VAR  UNAM  :  T_NAME; 

VAR  UNUM  :  CHAR8 ; 

VAR  COMMENT  :  CHAR150; 
VAR  NEXT_0P  :  OPERATIONS; 
VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

<**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  PROCEDURE  :  *) 

(*  DISPLAYS  THE  UPDATE  CLASS  MENU  1  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  KNUM  I  THE  ENTITY  KIND  NUMBER  *) 

(*  NAME  I  THE  ENTITY  NAME  *) 

(*  UNAM  0  THE  UPDATED  ENTITY  NAME  *) 

(*  UNUM  0  THE  UPDATED  ENTITY  NUMBER  *) 

(*  NEXT_0P  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

<*  *) 


(*  ^PROCESSING  DESCRIPTION:  *) 
(*  DISPLAY  THE  UPDATE  CLASS  PANEL  NUMBER  ONE  (UPCLASS1)  BY  *) 
(*  MAKING  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  *) 
(*  AN  ENUMERATED  TYPE.  THIS  DATA- AS  WELL  AS  OTHER  INFORMATION  *) 
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(*  GATHERED  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PRO-  *) 
(*  CEDURE.  *) 
(*  *) 
(*  ^COMMENTS:  *) 
(*  NONE  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 
(*  *) 
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(*  %INCLUDE  UPCLASS2  *) 

(**) 

PROCEDURE  UPCLASS2(VAR  MESS  :  MESSAGE; 

VAR  NAME  :  T_NAME; 

VAR  NUM  :  CHAR8; 

VAR  GROUP  :  T_ARRAYTV ; 

VAR  ARRAY_SI2E  :  INTEGER; 

VAR  MEMBER  :  T_NAME; 

VAR  NEXT_0P  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  PROCEDURE  :  *) 

(*  DISPLAYS  THE  UPDATE  CLASS  MENU  2  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  MEMBER  0  THE  MEMBER  SELECTED  TO  BE  UPDATED  *) 

(*  GROUP  I  THE  ARRAY  OF  MEMBERS  TO  SELECT  FROM  *) 

(*  ARRAY_SIZE  I  THE  SIZE  OF  THE  ARRAY  OF  MEMBERS  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

<*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *> 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  UPDATE  CLASS  PANEL  NUMBER  TWO  (UPCLASS2)  BY  *) 


(*  MAKING  ISPLNX  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  *) 
(*  AN  ENUMERATED  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  *) 
(*  GATHERED  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PRO-  *) 
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(*  CEDURE. 

(* 

(*  $ COMMENTS : 

(*  NONE 

(* 

(*  $ CHANGE  CONTROL: 
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(*  %INCLUDE  UPDEFTYP  *) 

(**) 

PROCEDURE  UPDEFTYP (VAR  MESS  :  MESSAGE; 

VAR  NAME  :  IDCHAR; 

VAR  FTYPE  :  ENTITY_TYPE; 

VAR  UNAM  :  CHARI 6; 

VAR  UTYPE  :  ENTITYJTYPE; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  CONTEXT  :  T_CONTEXT; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  UPDATE  DEFINED  TYPE  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NAME  I  THE  NAME  OF  THE  DEFINED  TYPE  *) 

(*  FTYPE  I  THE  TYPE  OF  THE  DEFINED  TYPE  *) 

(*  UNAM  0  THE  UPDATED  NAME  OF  THE  DEFINED  TYPE  *) 

(*  FTYPE  I  THE  UPDATED  TYPE  OF  THE  DEFINED  TYPE  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  CONTEXT  I  THE  CONTEXT  IN  WHICH  THE  DEFINED  TYPE  *) 

(*  IS  BEING  UPDATED  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  CREATE  DEFINED  TYPE  PANEL  (UPDEFTYP)  BY  MAKING  *) 
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(*  ISPLNK  GALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  *) 

(*  ENUMERATED  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  *) 

(*  GATHERED  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PRO-  *) 

(*  CEDURE.  *) 

<*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *> 

(*  REVISED:  JANUARY  1988  C.  H.  MOHME  DBMA  *) 

(*  MODIFIED  TO  INCORPORATE  THE  STRUCTURE  DATA  TYPE  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  PANEL  OPTION  NUMBERS;  ADDED  LIST  AND  SET.  NOTE:  THE  *) 

(*  LIST  AND  SET  DATA  TYPES  ARE  IMPLEMENTED  IN  THE  SOFTWARE  AS  AN  *) 

(*  ARRAY.  A  FIELD  WAS  ADDED  TO  THE  ARRAY  ADB  TO  SPECIFY  WHETHER  *) 

(*  THE  ARRAY  IS  A  CONCEPTUAL  ARRAY,  LIST,  OR  SET.  *) 

(*  *) 

(*  REVISED:  07/02/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  CURSOR  POSITIONING.  *) 

(*  *) 

(*  ORIGINATED:  07/31/86  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  % INCLUDE  UPDEFTYP  *) 
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(*  %INCLUDE  UPENTY1  *) 

(**) 

PROCEDURE  UPENTY1(VAR  MESS  :  MESSAGE; 

VAR  NAME  :  T_NAME; 

VAR  KNUM  :  CHAR8 ; 

VAR  UNAM  :  T_NAME; 

VAR  UNUM  :  CHAR8 ; 

VAR  COMMENT  :  CHAR150; 

VAR  NEXT_0P  :  OPERATIONS; 
VAR  RR  :  RET_REC); 


SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  PROCEDURE  :  *) 

(*  DISPLAYS  THE  UPDATE  ENTITY  MENU  1  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  =====  ===  ===========  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NAME  I  THE  ENTITY  NAME  *) 

(*  KNUM  I  THE  ENTITY  KIND  NUMBER  *) 

(*  UNAM  0  THE  UPDATED  ENTITY  NAME  *) 

(*  UNUM  0  THE  UPDATED  ENTITY  KIND  NUMBER  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  aRROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

<*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 


(*  ^PROCESSING  DESCRIPTION:  *) 
(*  DISPLAY  THE  UPDATE  ENTITY  PANEL  NUMBER  ONE  (UPENTY1)  BY  *) 
(*  MAKING  ISPLNK  CALLS,  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  *) 
(*  AN  ENUMERATED  TYPE,  THIS  DATA.  AS  WELL  AS  OTHER  INFORMATION  *) 
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GATHERED  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE 
(*  CEDURE. 

(* 

(*  ^COMMENTS: 

(*  NONE 

(* 

(*  $ CHANGE  CONTROL: 

(* 

(*  REVISED:  09/28/87  C.  H.  MOHME 

(*  INCORPORATED  THE  SUPERTYPE  DATA  TYPE. 

(* 

(*  REVISED:  08/13/87  C.  H.  MOHME 

(*  CHANGED  PANEL  OPTION  NUMBERS. 

(* 

(*  REVISED:  07/02/87  C.  H.  MOHME 

(*  CHANGED  CURSOR  POSITIONING. 

(* 

(*  ORIGINATED:  07/24/86  C.  H.  MOHME 

(* 

- - 

(* 

- - 

(*  END  7.INCLUDE  UPENTY1  *) 


CALLING  PRO- 


DBMA 


DBMA 


DBMA 


DBMA 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

._*) 

*) 

-*) 
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(*  %INCLUDE  UPENTY2  *) 
(**) 


PROCEDURE  UPENTY2(VAR  MESS 

VAR  FIELD_TYPE 
VAR  NAME 
VAR  KNUM 
VAR  MEM_ARRAY 
VAR  SIZE 
VAR  MEMBER 
VAR  NEXT_0P 
VAR  RR 

SUBPROGRAM; 

(**) 

<* - 

(* 

(*  $ FUNCTION: 

(*  THIS  PROCEDURE  : 

(*  DISPLAYS  THE 

(* 


MESSAGE; 
I_FIELDTYPE ; 
T_NAME; 

CHAR8 ; 

T_ARRAYID; 

INTEGER; 

T_NAME; 

OPERATIONS; 

RET_REC) ; 


UPDATE  ENTITY  MENU 


2 


(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

c* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


^DESCRIPTION  OF  ARGUMENTS: 

NAME  I/O  DESCRIPTION 


MESS 

FIELD_TYPE 

NAME 

KNUM 

MEM_ARRAY 

SIZE 

MEMBER 

NEXT.OP 

RR 


^COMMONS : 
NONE 


I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 
I  THE  TYPE  OF  FIELD 

I  THE  ENTITY  OR  SUPERTYPE  NAME 

I  THE  ENTITY  KIND  NUMBER 

I  THE  ARRAY  OF  MEMBERS  TO  SELECT  FROM 

I  THE  SIZE  OF  THE  ARRAY  OF  MEMBERS 
0  THE  MEMBER  SELECTED 

0  ENUMERATED  TYPE  INDICATING  THE  NEXT 

OPERATION 

0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 
IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 


^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

DDNAMES  USED  WITH  STANDARD  FILES: 

NONE 


^EXECUTION  PROCEDURE: 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

^PROCESSING  DESCRIPTION: 


•-*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*> 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 
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(*  DISPLAY  THE  UPDATE  ENTITY  PANEL  NUMBER  TWO  (UPENTY2)  BY  *) 

(*  MAKING  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  *) 

(*  AN  ENUMERATED  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  *) 

(*  GATHERED  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PRO-  *) 

(*  CEDURE.  *) 

(*  *) 

(*  $  COMMENTS:  ,  *) 

(*  NONE  '  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  UPENUM  *) 

(**) 

PROCEDURE  UPENUM(VAR  MESS  :  MESSAGE; 

VAR  MEMBERS  :  T_ARRAYID; 

VAR  SIZE  :  INTEGER; 

VAR  NAME  :  T_NAME; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

<*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  UPDATE  ENUMERATION  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  MEMBERS  I  THE  ARRAY  OF  MEMBERS  TO  DISPLAY  *) 

(*  SIZE  I  THE  SIZE  OF  THE  ARRAY  OF  NUMBERS  *) 

(*  NAME  0  THE  MEMBER  NAME  ENTERED  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

<*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

<*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISLAY  THE  REVIEW  ENUMERATION  MENU  (UPENUM)  BY  MAKING  *) 

(*  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  *) 

(*  ENUMERATED  TYPE.  *) 

(*  *) 

(*  $ COMMENTS:  *) 
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(* 

NONE 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

*) 

*) 
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(*  %INCLUDE  UPFIELD  *) 
(**) 


PROCEDURE  UPFIELD (VAR  MESS 
VAR  NAME 
VAR  POS 
(*  VAR  PURP 
VAR  REQD 
(*  VAR  DEPD 
VAR  FTYP 
VAR  FLDJTYP 
VAR  UNAM 
VAR  UPOS 
(*  VAR  UPUR 
VAR  UREQ 
(*  VAR  UDEP 
VAR  U_TYP 
VAR  COM 
VAR  NEXT_OP 
VAR  RR 


MESSAGE; 

T_NAME; 

CHAR8; 

CHAR8;  *) 
CHAR8 ; 
CHAR12;  *) 
ENTITY_TYPE; 
T_FIELDTYPE; 
T_NAME; 

CHAR8 ; 

CHAR8 ;  *) 
CHAR8 ; 

CHAR8 ;  *) 
ENTITY_TYPE; 
CHAR50; 
OPERATIONS; 
RET_REC) ; 


SUBPROGRAM; 


(**) 


<* 

(* 

^FUNCTION: 

*) 

*) 

(* 

THIS  PROCEDURE  : 

*) 

(* 

(* 

DISPLAYS  THE  UPDATE  FIELD  PANEL 

*) 

*) 

(* 

^DESCRIPTION 

OF  ARGUMENTS: 

*) 

(* 

NAME 

I/O 

DESCRIPTION 

*) 

(* 

===== 

sss 

it 

ii 

n 

ii 

ii 

ii 

u 

ii 

ii 

n 

ii 

*) 

<* 

MESS 

I 

THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 

*) 

(* 

NAME 

I 

THE  NAME  OF  THE  FIELD 

*) 

<* 

PURP 

I 

THE  PURPOSE  OF  THE  FIELD 

*) 

(* 

REQD 

I 

THE  REQUIREDNESS  OF  THE  FIELD 

*) 

(* 

(* 

DEPD 

I 

THE  DEPENDENCE/INDEPENDENCE  OF  THE  FIELD 
THE  FIELD 

*) 

*) 

(* 

FTYP 

I 

THE  TYPE  OF  THE  FIELD 

*) 

(* 

FLDJTYP 

I 

THE  TYPE  OF  FIELD 

*) 

(* 

UNAM 

0 

THE  UPDATED  NAME  OF  THE  FIELD 

*) 

(* 

UPUR 

0 

THE  UPDATED  PURPOSE  OF  THE  FIELD 

*) 

(* 

UREQ 

0 

THE  UPDATED  REQUIREDNESS  OF  THE  FIELD 

*) 

(* 

UDEP 

0 

THE  UPDATED  DEPENDENCE/INDEPENDENCE  OF 

*) 

<* 

UTYP 

0 

THE  UPDATED  TYPE  OF  THE  FIELD 

*> 

(* 

<* 

NEXT_OP 

0 

ENUMERATED  TYPE  INDICATING  THE  NEXT 
OPERATION 

*) 

*) 
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(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $  COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  '  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  UPDATE  FIELD  PANEL  (UPFIELD)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  GATHERED  *) 

(*  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PROCEDURE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  REVISED:  JANUARY  1988  C.  H.  MOHME  DBMA  *) 

(*  MODIFIED  TO  INCORPORATE  THE  STRUCTURE  DATA  TYPE  *) 

(*  *) 

(*  REVISED:  09/28/87  C.  H.  MOHME  DBMA  *) 

(*  INCORPORATED  THE  SUPERTYPE  DATA  TYPE.  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  PANEL  OPTION  NUMBERS;  CHANGED  FIELD  ADB  DATA;  ADDED  *) 

(*  LIST  AND  SET.  NOTE:  THE  LIST  AND  SET  DATA  TYPES  ARE  IMPLE-  *) 

(*  MENTED  IN  THE  SOFTWARE  AS  AN  ARRAY.  A  FIELD  WAS  ADDED  TO  THE  *) 

(*  ARRAY  ADB  TO  SPECIFY  WHETHER  THE  ARRAY  IS  A  CONCEPTUAL  ARRAY,  *) 

(*  LIST,  OR  SET.  *) 

(*  *  *) 

(*  REVISED:  07/02/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  CURSOR  POSITIONING.  *) 

(*  *) 

(*  ORIGINATED:  07/15/86  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  UPFIELD  *) 
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(*  %INCLUDE  UPINT  *) 

(**) 

PROCEDURE  UPINT (VAR  MESS  :  MESSAGE; 

VAR  PREC  :  CHAR8 ; 

VAR  UPREC  :  CHAR8; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  UPDATE  INTEGER  MENU  *) 

<*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  PREC  I  THE  PRECISION  OF  THE  INTEGER  *) 

(*  UPREC  0  THE  UPDATED  PRECISION  OF  THE  INTEGER  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  UPDATE  INTEGER  PANEL  (UPINT)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  GATHERED  *) 

(*  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PROCEDURE.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  ‘  *) 
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(*  $ CHANGE  CONTROL: 

(*  REVISED:  10/09/87  c* 

(*  ADDED  DEFAULT  PRECISION. 

(*  REVISED:  08/13/87  c*  H* 

(*  CHANGED  PANEL  OPTION  NUMBERS. 

(*  REVISED:  07/02/87  C.  H.  MOHME 

(*  CHANGED  CURSOR  POSITIONING. 

(*  ORIGINATED:  08/04/86  C.  H.  MOHME 

(* 

- - 

(* 

- - 

(*  END  %INCLUDE  UPINT  *) 


*) 

*) 

DBMA  *) 
*) 
*) 

DBMA  *) 

*) 
*) 

DBMA  *) 

*) 
*> 

DBMA  *) 

*) 

- *) 

*) 

- *) 
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(*  7.INCLUDE  UPLIST  *) 

(**) 

PROCEDURE  UPLIST (VAR  MESS 
VAR  MIN 
VAR  MAX 
VAR  ATYPE 
VAR  UMIN 
VAR  UMAX 
VAR  UTYPE 
VAR  NEXT_OP 
VAR  CONTEXT 
VAR  RR 

SUBPROGRAM; 


MESSAGE; 
CHAR8 ; 

CHAR8 ; 

ENTITY_TYPE; 
CHAR8 ; 

CHAR8 ; 

ENTITY_TYPE ; 
OPERATIONS; 
T_C0NTEXT ; 
RET_REC); 


^FUNCTION: 

THIS  FUNCTION: 


DISPLAYS  THE  UPDATE  LIST  MENU 


^DESCRIPTION  OF  ARGUMENTS: 


DESCRIPTION 


ATYPE 

UMIN 


UTYPE 

NEXT_OP 

CONTEXT 


THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 
THE  MINIMUM  NUMBER  OF  OCCURRENCES  IN  THE  *) 
LIST  *) 
THE  MAXIMUM  NUMBER  OF  OCCURRENCES  IN  THE  *) 
LIST  *) 
THE  LIST  TYPE  *) 
THE  UPDATED  MINIMUM  NUMBER  OF  OCCUR-  *) 
RENCES  IN  THE  LIST  *) 
THE  UPDATED  MAXIMUM  NUMBER  OF  OCCUR-  *) 
RENCES  IN  THE  LIST  *) 
THE  UPDATED  LIST  TYPE  *) 
ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 
OPERATION  *) 
THE  CONTEXT  IN  WHICH  THE  LIST  IS  BEING  *) 
UPDATED  *) 
INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 
IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 


^COMMONS : 

NONE 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 
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(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 


DDNAMES  USED  WITH  STANDARD  FILES: 

NONE 

^EXECUTION  PROCEDURE: 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

^PROCESSING  DESCRIPTION: 

DISPLAY  THE  UPDATE  LIST  PANEL  (UPLIST)  BY  MAKING  ISPLNK 
CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED 
TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  GATHERED 
FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PROCEDURE. 

^COMMENTS : 

NONE 

$ CHANGE  CONTROL: 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  ^INCLUDE  UPPNTR  *) 

(**) 

PROCEDURE  UPPNTR (VAR  MESS  :  MESSAGE; 

VAR  GROUP  :  T_ARRAYTV ; 

VAR  ARRAY_SIZE  :  INTEGER; 

VAR  MEMBER  :  T_NAME; 

VAR  NEXT_0P  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  PROCEDURE  :  *) 

(*  DISPLAYS  THE  UPDATE  POINTER  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  GROUP  I  THE  ARRAY  OF  MEMBERS  TO  SELECT  FROM  *) 

(*  ARRAYJ5IZE  I  THE  SIZE  OF  THE  ARRAY  OF  MEMBERS  *) 

(*  MEMBER  0  THE  MEMBER  SELECTED  TO  BE  UPDATED  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  UPDATE  POINTER  PANEL  (UPPNTR)  BY  MAKING  ISPLNK  *) 

(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 

(*  TYPE.  *) 

(*  *) 

(*  $ COMMENTS :  *) 

(*  NONE  ‘  *) 

(*  *> 

(*  $ CHANGE  CONTROL:  *) 
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(*  %INCLUDE 
(**) 

PROCEDURE 


UPREAL  *) 

UPREAL (VAR  MESS 
VAR  PREC 
VAR  UPREC 
VAR  NEXT_OP 
VAR  RR 


MESSAGE; 
CHAR 8 ; 

CHAR8 ; 
OPERATIONS; 
RET_REC) ; 


(**) 

SUBPROGRAM; 

(* — 
(* 

(* 

^FUNCTION: 

(* 

THIS  FUNCT 

(* 

(* 

(* 

^DESCRIPTION 

(* 

NAME 

(* 

(* 

MESS 

<* 

PREC 

(* 

UPREC 

(* 

(* 

NEXT_OP 

(* 

(* 

RR 

(* 

(* 

(* 

^COMMONS: 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

<* 

(* 


DISPLAYS  THE  UPDATE  REAL  MENU 


I/O  DESCRIPTION 

T  THE~ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 
I  THE  REAL  SIZE  IN  DECIMAL  DIGIT  FORM 
0  THE  UPDATED  REAL  SIZE  IN  DECIMAL  DIGIT 
FORM 

0  ENUMERATED  TYPE  INDICATING  THE  NEXT 
OPERATION 

0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 
IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 


NONE 

^ENVIRONMENT; 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

DDNAMES  USED  WITH  STANDARD  FILES: 

NONE 

^EXECUTION  PROCEDURE: 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

^PROCESSING  DESCRIPTION: 

DISPLAY  THE  UPDATE  REAL  PANEL  (UPREAL)  BY  MAKING  ISPLNK 
CALLS  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED 
TYPE.*  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  GATHERED 
FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PROCEDURE. 


■*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 
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(* 

^COMMENTS: 

*) 

(* 

NONE 

*) 

(* 

*) 

(* 

$ CHANGE  CONTROL: 

*) 

(* 

*) 

(* 

REVISED:  10/09/87  C. 

H.  MOHME 

DBMA 

*) 

(* 

ADDED  DEFAULT  PRECISION. 

*) 

(* 

*) 

(* 

REVISED:  08/13/87  C. 

H.  MOHME 

DBMA 

*) 

(* 

CHANGED  PANEL  OPTION  NUMBERS 

* 

*) 

(* 

*) 

(* 

REVISED:  07/02/87  C. 

H.  MOHME 

DBM 

*) 

<* 

CHANGED  CURSOR  POSITIONING. 

*) 

(* 

*) 

(* 

ORIGINATED:  08/05/86  C. 

H.  MOHME 

DBM 

*) 

(* 

*) 

(*- 

--*) 

(* 

*) 

(*END - 

--*) 

(* 

END  7.INCLUDE  UPREAL  *) 
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(*  ^INCLUDE  UPSET  *) 
(**) 


PROCEDURE  UPSET (VAR  MESS 

MESSAGE; 

VAR  MIN 

CHAR 8; 

VAR  MAX 

CHAR8 ; 

VAR  ATYPE 

ENTITY_TYPE 

VAR  UMIN 

CHAR8 ; 

VAR  UMAX 

CHAR8 ; 

.  VAR  UTYPE 

ENTITY_TYPE 

VAR  NEXT_OP 

OPERATIONS; 

VAR  CONTEXT 

T_C0NTEXT; 

VAR  RR 

RET_REC) ; 

SUBPROGRAM; 

(**) 


<*- 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

<* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 


^FUNCTION: 

THIS  FUNCTION: 

DISPLAYS  THE  UPDATE  SET  MENU 


^DESCRIPTION  OF  ARGUMENTS: 

NAME  I/O  DESCRIPTION 


MESS 

MIN 

MAX 

ATYPE 

UMIN 

UMAX 

UTYPE 

NEXTJJP 

CONTEXT 

RR 


$ COMMONS : 
NONE 


I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 

I  THE  MINIMUM  NUMBER  OF  OCCURRENCES  IN  THE 
SET 

I  THE  MAXIMUM  NUMBER  OF  OCCURRENCES  IN  THE 
SET 

I  THE  SET  TYPE 

0  THE  UPDATED  MINIMUM  NUMBER  OF  OCCUR¬ 

RENCES  IN  THE  SET 

0  THE  UPDATED  MAXIMUM  NUMBER  OF  OCCUR¬ 
RENCES  IN  THE  SET 

0  THE  UPDATED  SET  TYPE 

0  ENUMERATED  TYPE  INDICATING  THE  NEXT 

OPERATION 

I  THE  CONTEXT  IN  WHICH  THE  SET  IS  BEING 
UPDATED 

0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 
IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 


^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 


» . 
i 
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(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 
(*  NONE  *) 
(*  *) 
(*  ^EXECUTION  PROCEDURE:  *) 
(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 
(*  *) 
(*  ^PROCESSING  DESCRIPTION:  *) 
(*  DISPLAY  THE  UPDATE  SET  PANEL  (UPSET)  BY  MAKING  ISPLNK  *) 
(*  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED  *) 
(*  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  GATHERED  *) 
(*  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PROCEDURE.  *) 
(*  *) 
(*  ^COMMENTS:  *) 
(*  NONE  *) 
(*  *) 
(*  ^CHANGE  CONTROL:  *) 
(*  *) 
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(*  %INCLUDE  UPSTRING  *) 

(**) 

PROCEDURE  UPSTRING(VAR  MESS 

VAR  LEN 
VAR  ULEN 
VAR  NEXT_OP 
VAR  RR 

SUBPROGRAM; 

<**) 

(* - 


MESSAGE; 
CHAR8 ; 

CHAR8 ; 
OPERATIONS; 
RET_REC) ; 


^FUNCTION: 

THIS  FUNCTION: 


DISPLAYS  THE  UPDATE  STRING  MENU 


^DESCRIPTION  OF  ARGUMENTS: 

NAME  I/O  DESCRIPTION 


MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 

LEN  I  THE  LENGTH  OF  THE  STRING  IN  BYTES 

ULEN  0  THE  UPDATED  LENGTH  OF  THE  STRING  IN 

BYTES 

NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT 

OPERATION 

RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 

IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 

^COMMONS : 

NONE 

^ENVIRONMENT : 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

DDNAMES  USED  WITH  STANDARD  FILES: 

NONE 

^EXECUTION  PROCEDURE: 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

^PROCESSING  DESCRIPTION: 

DISPLAY  THE  UPDATE  STRING  PANEL  (UPSTRING)  BY  MAKING  ISPLNK 
CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  ENUMERATED 
TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  GATHERED 
FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PROCEDURE. 

^COMMENTS : 

NONE 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  REVISED:  10/09/37  C.  H.  MOHME  DBMA  *) 

(*  ADDED  DEFAULT  STRING  LENGTH.  *) 

(*  *) 

(*  REVISED:  08/13/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  PANEL  OPTION  NUMBERS.  *) 

(*  ‘  *) 
(*  REVISED:  07/02/87  C.  H.  MOHME  DBMA  *) 

(*  CHANGED  CURSOR  POSITIONING.  *) 

(*  *) 

(*  ORIGINATED:  08/05/86  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

<*  *) 

(*END - *) 

(*  END  %INCLUDE  UPSTRING  *) 
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(*  %INCLUDE  UPSTRUC  *) 

(**) 

PROCEDURE  UPSTRUC(VAR  MESS  :  MESSAGE; 

VAR  CLAS  :  T_ARRAYID; 

VAR  ARRAY_SIZE  :  INTEGER; 

VAR  MEMBER  :  T.NAME; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  PROCEDURE  :  *) 

(*  DISPLAYS  THE  UPDATE  STRUCTURE  MENU  *) 

(*  RECEIVES  THE  NAME  OF  A  STRUCTURE  TO  BE  UPDATED  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  RECEIVED  FROM  MAINLINE  *) 

(*  CLAS  I  THE  ARRAY  OF  FIELDS  *) 

(*  ARRAY_S I 2E  I  THE  SIZE  OF  THE  ARRAY  OF  MEMBERS  *) 

(*  MEMBER  0  THE  MEMBER  SELECTED  *) 

(*  NEXT_OP  0  TELLS  THE  MAINLINE  WHAT  PANEL  TO  CALL  *) 

(*  NEXT  *) 

(*  RR  0  TELLS  THE  MAINLINE  IF  THERE  IS  AN  ERROR  *) 

(*  AND  IN  WHAT  ROUTINE  IT  OCCURS  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  * ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  UPDATE  STRUCTURE  PANEL  (UPSTRUC)  BY  MAKING  *) 

(*  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  *) 

(*  ENUMERATED  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  *) 

(*  GATHERED  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  *) 

(*  PROCEDURE.  -  *) 

(*  *) 
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^COMMENTS: 

$ CHANGE  CONTROL: 


*) 

*) 

*) 


Cl  PS560240032U 
April  1990 


(*  %INCLUDE  UPSUB1  *) 

(**) 

PROCEDURE  UPSUB1(VAR  MESS  :  MESSAGE; 

VAR  NAME  :  T_NAME; 

VAR  UNAM  :  T_NAME; 

VAR  COMMENT  :  CHAR150; 

VAR  NEXT_0P  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  UPDATE  SUBSCHEMA  PANEL  1  *) 

(*  INPUT  OF  THE  NAME  OF  A  SUBSCHEMA  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  RECEIVED  FROM  MAINLINE  *) 

(*  NAME  I  THE  SUBSCHEMA  NAME  *) 

(*  UNAM  0  THE  UPDATED  SUBSCHEMA  NAME  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  XRC  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

<*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *> 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  UPDATE  SUBSCHEMA  PANEL  (UPSUB1)  BY  MAKING  *) 

(*  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  *) 

(*  ENUMERATED  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  *) 

(*  GATHERED  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  *) 

(*  PROCEDURE.  *) 
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(*  *) 

(*  $ COMMENTS :  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

<*  *) 
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(*  7.INCLUDE  UPSUB2  *) 

(**) 

PROCEDURE  UPSUB2(VAR  MESS  :  MESSAGE; 

VAR  NAME  :  T_NAME; 

VAR  MEMBERS  :  T.ARRAYTV; 

VAR  ARRAY_SIZE  :  INTEGER; 

VAR  MEMBER  :  T_NAME; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  FUNCTION:  *) 

(*  DISPLAYS  THE  REVIEW  SUBSCHEMA  PANEL  2  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NAME  I  THE  NAME  OF  THE  SUBSCHEMA  TO  BE  UPDATED  *) 

(*  MEMBERS  I  THE  ARRAY  OF  MEMBERS  TO  SELECT  FROM  *) 

(*  ARRAY_SIZE  I  THE  SIZE  OF  THE  ARRAY  OF  MEMBERS  *) 

(*  MEMBER  0  THE  MEMBER  SELECTED  *) 

(*  NEXT.0P  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  UPDATE  SUBSCHEMA  PANEL  NUMBER  TWO  BY  MAKING  *) 

(*  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO  AN  *) 

(*  ENUMERATED  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION  *) 

(*  GATHERED  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  *) 
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(*  PROCEDURE. 

(* 

(*  $ COMMENTS : 

(*  NONE 

(* 

(*  $ CHANGE  CONTROL: 

(* 


*) 

*) 

*) 

*) 

*) 

*) 

*) 


> 
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(*  %INCLUDE  UPSUPER  *) 

(**) 

PROCEDURE  UPSUPER(VAR  MESS 
VAR  NAME 
VAR  UNAM 

VAR  REMOVE_SUPERTYPE 
VAR  NEXT_0P 
VAR  RR 

SUBPROGRAM; 

(**) 

(* - 


MESSAGE; 
T_NAME; 
T_NAME; 
BOOLEAN; 
OPERATIONS ; 
RET_REC) ; 


^FUNCTION: 

THIS  PROCEDURE  : 

DISPLAYS  THE  UPDATE  SUPERTYPE  MENU 

^DESCRIPTION  OF  ARGUMENTS: 

NAME  I/O  DESCRIPTION 


MSS 
NAME 
KNUM 
UNAM 
UNUM 
NEXT  OP 


THE  ERROR  MSSAGE  DISPLAYED  ON  THE  PANEL 

THE  ENTITY  NAM 

THE  ENTITY  KIND  NUMBER 

THE  UPDATED  ENTITY  NAM 

THE  UPDATED  ENTITY  KIND  NUMBER 

ENUMRATED  TYPE  INDICATING  THE  NEXT 

OPERATION 

INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 
IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 


$ COMMONS : 

NONE 

$ENVIRONMNT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

DDNAMS  USED  WITH  STANDARD  FILES: 

NONE 

^EXECUTION  PROCEDURE: 

SCHEMA  EXECUTIVE  MNU  INTERFACE  ROUTINE 

^PROCESSING  DESCRIPTION: 

DISPLAY  THE  UPDATE  ENTITY  PANEL  NUMBER  ONE  (UPSUPER)  BY 
MAKING  ISPLNK  CALLS.  THE  OPTION  CHOSEN  IS  TRANSLATED  INTO 
AN  ENUMRATED  TYPE.  THIS  DATA  AS  WELL  AS  OTHER  INFORMATION 
GATHERED  FROM  THE  PANEL  IS  PASSED  BACK  TO  THE  CALLING  PRO¬ 
CEDURE. 
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(*  $ COMMENTS : 

(*  NONE 

(* 

(*  $ CHANGE  CONTROL: 

(* 


*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  XATTDATA  *) 

(**) 

PROCEDURE  XATTDATA (VAR  IRC  :  RET_REC; 

VAR  XREFFILE  :  TEXT); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GENERATES  A  LIST  OF  ALL  "ENTITIES"  CONTAINING  *) 

(*  A  PARTICULAR  "ENTITY. "  *) 

<*  *) 

(*  {DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  XREFFILE  0  CROSS  REFERENCE  REPORT  FILE  *) 

(*  *) 

(*  $ COMMONS :  *) 

(*  NONE  *) 

(*  *) 

(*  {ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  {EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  {PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  CROSS  REFERENCE  MENU.  *) 

(*  DETERMINE  WHICH  OPTION  WAS  CHOSEN  AND  CALL  THE  APPROPRIATE  *) 

(*  ROUTINE.  *) 

(*  INTEGER  DATA  TYPE.  DISPLAY  MENU  TO  OBTAIN  DESIRED  *) 

(*  PRECISION.  *) 

(*  REAL  DATA  TYPE.  DISPLAY  MENU  TO  OBTAIN  DESIRED  PRECISION.  *) 

(*  STRING  DATA  TYPE.  DISPLAY  MENU  TO  OBTAIN  DESIRED  LENGTH.  *) 

(*  OTHER  DATA  TYPES.  *) 

(*  ARRAY,  LIST,  OR  SET  DATA  TYPE.  *) 

(*  THE  LIST  AND  SET  DATA  TYPES  ARE  IMPLEMENTED  AS  ARRAYS.  *) 

(*  THEREFORE,  SPECIAL  CHECKING  MUST  BE  PERFORMED.  *) 

(*  IF  A  PRECISION  WAS  SPECIFIED  FOR  THE  INTEGER,  REAL,  OR  STRING  *) 

(*  DATA  TYPE,  THEN  SELECT  FROM  THE  DATA  TYPE  LIST  THOSE  *) 

(*  ENTITIES  WITH  THE  SPECIFIED  PRECISION.  *) 

(*  MAKE  A  LIST  OF  THE  USERS  OF  THE  DATA  TYPE  AND  CALL  THE  *) 

(*  ROUTINE  TO  DISPLAY  THE  ATTRIBUTES  AND  USER  ENTITIES.  *) 

<*  *) 

(*  {COMMENTS:  *) 

(*  ‘  *) 
(*  {CHANGE  CONTROL:  *) 
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(*  %INCLUDE  XATTNAME  *) 

(**) 

PROCEDURE  XATTNAME (VAR  IRC  :  RET_REC; 

VAR  XREFFILE  :  TEXT); 

SUBPROGRAM; 

<**) 

(* - 

(* 

(*  $ FUNCTION: 

(*  THIS  ROUTINE  GENERATES  A  LIST  OF  ALL  ENTITIES  HAVING  AN 

(*  ATTRIBUTE  WITH  A  SPECIFIED  NAME. 

(* 

(*  ^DESCRIPTION  OF  ARGUMENTS: 

(*  NAME  I/O  DESCRIPTION 

(*  IRC  0  RETURN  CODE 

(*  XREFFILE  0  THE  CROSS  REFERENCE  REPORT  FILE 

(* 

(*  $ COMMONS; 

(*  NONE 

<* 

(*  ^ENVIRONMENT: 

(*  LANGUAGE:  IBM  PASCAL 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(*  ^EXECUTION  PROCEDURE: 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 

(* 

(*  ^PROCESSING  DESCRIPTION: 

(*  DETERMINE  THE  ATTRIBUTE  NAME. 

(*  DETERMINE  IF  A  VALID  IDENTIFIER  WAS  ENTERED. 

(*  MAKE  A  LIST  OF  ATTRIBUTES  OF  THE  SPECIFIED  NAME. 

(*  MAKE  A  LIST  OF  THE  ENTITY  USERS. 

(*  PREPARE  TO  DISPLAY  THE  RESULTS. 

(*  DISPLAY  THE  RESULTS. 

(*  RETURN  TO  MAIN  MENU. 

(* 

(*  $ COMMENTS: 

(* 

(*  $ CHANGE  CONTROL: 

(* 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  XATTRES  *) 
(**) 

PROCEDURE  XATTRES (VAR 
VAR 
VAR 
VAR 
VAR 
’  VAR 
VAR 
VAR 


IRC 

ATTRIBUTE_LIST 

DATA_T YPE_K IND 

PRECISION 

C0M1 

COM2 

XREFFILE 

OPTION 


SUBPROGRAM; 

(**) 


RET_REC; 

LISTKEY; 

INTEGER; 

INTEGER; 

CHAR50; 

CHAR50; 

TEXT; 

OPERATIONS); 


(*■ 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

<* 

(* 

(* 

<* 

(* 

<* 

(* 

<* 

(* 


$ FUNCTION: 

DISPLAYS  CROSS  REFERENCE  REPORT  RESULTS 

^DESCRIPTION  OF  ARGUMENTS: 

NAME 

IRC 

ATTRIBUTE_LIST 
DATA_TYPE_KIND 

PRECISION 

COM1 
COM2 

XREFFILE 
OPTION 

$ COMMONS : 

NONE 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 
^PROCESSING  DESCRIPTION: 

READ  EACH  ATTRIBUTE  OFF  OF  THE  LIST  OF  ATTRIBUTES 
FROM  THE  ATTRIBUTE  ADB  OBTAIN  THE  ATTRIBUTE  NAME  AND  PUT  IT 
INTO  AN  ARRAY. 

FIND  THE  LIST  OF  USERS  OF  THE  ATTRIBUTE.  THIS  LIST  WILL 
ALWAYS  CONSIST  OF  ONE  AND  ONLY  ONE  MEMBER. 


I/O  DESCRIPTION 

0  RETURN  CODE 

I  THE  LIST  OF  ATTRIBUTES 

I  THE  DATA  TYPE  KIND  TO  BE  FOUND  IN  THE 
ATTRIBUTE  LIST 

I  THE  INTEGER  OR  REAL  PRECISION,  OR  THE 
STRING  LENGTH 
I  THE  MENU  COMMENTS 

I  THE  MENU  COMMENTS 

I/O  THE  CROSS  REFERENCE  REPORT  FILE 

0  THE  OPTION  SELECTED 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  FROM  THE  USER  ADB,  OBTAIN  THE  USER  NAME  AND  PUT  IT  INTO  AN  *) 

(*  ARRAY.  IF  THE  USER  IS  A  GLOBAL  ATTRIBUTE,  PUT  THE  KEYWORD  *) 

(*  "GLOBAL"  INTO  THE  ARRAY.  *) 

(*  DEFINE  THE  COMMENTS  FOR  THE  CROSS  REFERENCE  REPORT  *) 

(*  DISPLAY  THE  CROSS  REFERENCE  REPORT  RESULT  MENU  *) 

(*  *) 

(*  ^COMMENTS:  *) 

<*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  XEXPREC  *) 

(**) 

PROCEDURE  XEXPREC(VAR  IRC  :  RET_REC; 

CONST  ENT.KIND  :  INTEGER; 

VAR  XREFFILE  :  TEXT; 

VAR  MSG  :  MESSAGE); 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  GENERATES  A  LIST  OF  ALL  EXISTING  PRECISIONS  *) 

(*  FOR  THE  INTEGER,  REAL,  OR  STRING  DATA  TYPE.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  ENTJKIND  0  THE  ENTITY  KIND  *) 

<*  XREFFILE  0  THE  CROSS  REFERENCE  REPORT  FILE  *) 

(*  MSG  0  PANEL  MESSAGE  *) 

<*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  ESTABLISH  THE  MAXIMUM  PRECISION  AND  THE  DISPLAY  MESSAGE.  *) 

(*  THE  EXISTS  ARRAY  IS  USED  TO  HOLD  BOOLEAN  VALUES.  EXISTS(.X.)  *) 
(*  IS  TRUE  IF  THE  X  PRECISION  EXISTS  FOR  THE  INTEGER,  REAL,  OR  *) 

(*  STRING  DATA  TYPE  IN  THE  SCHEMA  MODEL.  *) 

(*  MAKE  A  LIST  OF  THE  INTEGER,  REAL,  OR  STRING  DATA  TYPES  AND  *) 

(*  •  DETERMINE  THE  EXISTING  PRECISIONS.  *) 

(*  PREPARE  TO  DISPLAY  THE  RESULTS.  *) 

(*  DISPLAY  THE  RESULTS.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

<*  *) 
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(*  %INCLUDE  XFNDARY  *) 

(**) 

PROCEDURE  XFNDARY (CONST  ENTITYJCEY  :  ENTKEY; 

VAR  ADB  :  ENTBLOCK; 

VAR  DATA  :  BLKDATA ; 

VAR  RRC  :  EXT_RET_CODE) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  FINDS  ALL  ARRAY  DATA  TYPES  OF  SET,  LIST,  OR  *) 

(*  ARRAY  AND  PUTS  THEM  ON  A  LIST.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  ENTITYJCEY  I  KEY  TO  THE  ENTITY  *) 

(*  ADB  0  DATA  STORED  IN  THE  ADB  *) 

(*  DATA  I/O  THE  USER  DEFINED  DATA  STRUCTURE  USED  *) 

(*  TO  PASS  DATA  INTO  THIS  PROCEDURE  AND  *) 

(*  TO  GET  THE  DESIRED  OUTPUT  FROM  THE  *) 

(*  PROCEDURE  *) 

(*  RRC  0  EXTERNAL  RETURN  CODE  *) 

(*  =  0  OK  *) 

(*  >=10  ERROR  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

<*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  IS  CALLED  BY  A  MAS  EXECUTE  ROUTINE.  ALL  *) 

(*  ARRAY  DATA  TYPES  OF  SET,  LIST,  OR  ARRAY  ARE  PUT  ONTO  A  *) 

(*  LIST.  *) 

(*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 


Cl  PS560240032U 
April  1990 


(*  %INCLUDE  XFNDKEY  *) 

(**) 

PROCEDURE  XFNDKEY (VAR  IRC 


SUBPROGRAM; 

(**) 


VAR  CHAR_STRING 
VAR  BAD_NAME 
VAR  BAD_KIND_NUMBER 
VAR  NUMBER 
CONST  ENT  KIND 


RET_REC ; 

T_NAME; 

BOOLEAN; 

BOOLEAN; 

INTEGER; 

INTEGER) ; 


(*• 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 


^FUNCTION; 

THIS  ROUTINE  DETERMINES  THE  KEY  FOR  A  GIVEN  ENTITY  NAME 
OR  NUMBER 

^DESCRIPTION  OF  ARGUMENTS: 

NAME 

IRC 

CHAR_STRING 
BADJTAME 

BAD_KIND_NUMBER 

NUMBER 

DATA_REC 
ENTJCIND 

$ COMMONS : 

NONE 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 
^PROCESSING  DESCRIPTION: 

INITIALIZE  THE  RECORD  USED  BY  MAS  IN  MAKXEQ.  THIS  RECORD 
CONTAINS  AN  ENTITY  NAME  OR  KIND  NUMBER.  THE  MAKXEQ  ROUTINE 
WILL  RETURN  THE  ENTITY  KEY,  IF  THE  ENTITY  EXISTS  IN  THE 
MODEL. 

^COMMENTS: 

^CHANGE  CONTROL: 

3-606 


I/O  DESCRIPTION 
0  RETURN  CODE 

I  THE  GIVEN  CHARACTER  STRING 
0  INDICATES  IF  THE  GIVEN  CHARACTER  STRING 
IS  A  NAME 

0  INDICATES  IF  THE  GIVEN  CHARACTER  STRING 
IS  A  NUMBER 

0  THE  NUMBER  CONTAINED  IN  THE  CHARACTER 
STRING 

0  THE  RECORD  USED  BY  MAKXEQ 

I  THE  ENTITY  KIND 


•*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  XFNDNAME  *) 
(**) 


PROCEDURE  XFNDNAME (CONST 

ENTITYJCEY 

:  ENTKEY; 

VAR 

ADB 

:  ENTBLOCK; 

VAR 

DATA 

:  BLKDATA ; 

VAR 

RRC 

:  EXT_RET_CODE) ; 

SUBPROGRAM; 


(**) 

(*— 

(* 

(* 

^FUNCTION: 

(* 

THIS  ROUTINE  FINDS  ALL  ATTRIBUTES  WITH  THE  GIVEN  NAME  AND 

(* 

PUTS  THEM  - 

ON  A  LIST. 

(* 

(* 

^DESCRIPTION  OF 

ARGUMENTS : 

(* 

/* 

NAME 

I/O  DESCRIPTION 

\ 

(* 

ENTITYJCEY 

I  KEY  TO  THE  ENTITY 

(* 

ADB 

0  DATA  STORED  IN  THE  ADB 

(* 

DATA 

I/O  THE  USER  DEFINED  DATA  STRUCTURE  USED 

(* 

TO  PASS  DATA  INTO  THIS  PROCEDURE  AND 

(* 

TO  GET  THE  DESIRED  OUTPUT  FROM  THE 

<* 

PROCEDURE 

(* 

RRC 

0  EXTERNAL  RETURN  CODE 

(* 

=  0  OK 

(* 

>=  10  ERROR 

(* 

<* 

^COMMONS: 

(* 

NONE 

(* 

(* 

^ENVIRONMENT: 

(* 

LANGUAGE:  IBM  PASCAL 

(* 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

(* 

(* 

^EXECUTION  PROCEDURE: 

(* 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 

<* 

(* 

^PROCESSING  DESCRIPTION: 

(* 

THIS  ROUTINE  IS  CALLED  BY  A  MAS  EXECUTE  ROUTINE.  ALL 

(* 

ATTRIBUTES 

WITH  THE  GIVEN  NAME  ARE  RETURNED  IN  A  LIST. 

<* 

<* 

$ COMMENTS : 

(* 

(* 

$ CHANGE  CONTROL 

« 

• 

(* 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  XFNDPREC  *) 

(**) 

PROCEDURE  XFNDPREC (CONST  ENTITYJCEY  :  ENTKEY; 


VAR 

ADB 

:  ENTBLOCK; 

VAR 

DATA 

:  BLKDATA ; 

VAR 

RRC 

:  EXT_RET_CODE) ; 

SUBPROGRAM; 

(**) 


(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  FINDS  ALL  INTEGERS,  REALS,  OR  STRINGS  WITH  *) 

(*  THE  SPECIFIED  PRECISION  AND  PUTS  THEM  ON  A  LIST.  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  ENTITYJCEY  I  KEY  TO  THE  ENTITY  *) 

<*  ADB  0  DATA  STORED  IN  THE  ADB  *) 

(*  DATA  I/O  THE  USER  DEFINED  DATA  STRUCTURE  USED  *) 

(*  TO  PASS  DATA  INTO  THIS  PROCEDURE  AND  *) 

(*  TO  GET  THE  DESIRED  OUTPUT  FROM  THE  *) 

(*  PROCEDURE  *) 

(*  RRC  0  EXTERNAL  RETURN  CODE  *) 

(*  =0  OK  *) 

(*  >=  10  ERROR  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

<*  ^PROCESSING  DESCRIPTION:  *) 

(*  THIS  ROUTINE  IS  CALLED  BY  A  MAS  EXECUTE  ROUTINE.  ALL  *) 

(*  INTEGERS,  REALS,  OR  STRINGS  WITH  THE  SPECIFIED  PRECISION  *) 

<*  ARE  FOUND  AND  PUT  ONTO  A  LIST.  *) 

<*  *) 

(*  ^COMMENTS:  *) 

(*  *) 

(*  ^CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  XLI STENT  *) 

(**) 

PROCEDURE  XLI STENT (VAR  IRC  :  RET_REC ; 

CONST  SPECIFIED_KEY_KIND  :  INTEGER; 

CONST  RESULT_LIST_KIND  :  INTEGER; 

VAR  XREFFILE  :  TEXT); 


(**) 

<*— 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

<* 

<* 

(* 

(* 

(* 

(* 


SUBPROGRAM; 


^FUNCTION: 

THIS  ROUTINE  GENERATES  A  LIST  OF  ALL  "ENTITIES"  CONTAINING 
A  PARTICULAR  ENTITY. 

^DESCRIPTION  OF  ARGUMENTS: 

NAME 

IRC 

SPECIFIED_KEY_KIND 

RESULT_LIST_KIND 
XREFFILE 

$ COMMONS : 

NONE 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

^EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 

.^PROCESSING  DESCRIPTION: 

DISPLAY  THE  CROSS  REFERENCE  MENU 

DEFINE  THE  MENU  COMMENTS  TO  DISPLAY  FOR  THE  USER'S  INFORMATION 
DISPLAY  THE  SPECIFICATION  MENU,  IF  APPROPRIATE 
DETERMINE  WHICH  OPTION  WAS  CHOSEN  AND  CALL  THE  APPROPRIATE 
ROUTINE 

DETERMINE  IF  A  VALID  NAME  OR  NUMBER  WAS  ENTERED 
DETERMINE  THE  KEY  OF  THE  NAME  OR  NUMBER  SPECIFIED 
CREATE  THE  DESIRED  LIST  AND  DEFINE  THE  CROSS  REFERENCE  REPORT 
COMMENTS 

FIND  ALL  ATTRIBUTES  OF  THE  SPECIFIED  DEFINED  TYPE 
FIND  ALL  CLASSES  CONTAINING  THE  SPECIFIED  ENTITY 
FIND  ALL  SUBSCHEMAS  CONTAINING  THE  SPECIFIED  ENTITY 
FIND  ALL  SUBSCHEMAS  CONTAINING  THE  SPECIFIED  CLASS 


I/O  DESCRIPTION 
0  RETURN  CODE 

I  THE  ENTITY  KIND  OF  THE  PARTICULAR  ENTITY 
TO  BE  FOUND. 

I  THE  ENTITY  KIND  OF  THE  RESULTING  LIST 
0  THE  CROSS  REFERENCE  REPORT  FILE 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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display  the  results 

return  to  main  menu 

*) 

$ COMMENTS: 

*) 

*) 

$ CHANGE  CONTROL: 

*) 

*) 

*) 
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(*  %INCLUDE  XMAIN  *) 

(**) 

PROCEDURE  XMAIN(VAR  IRC  :  RET_REC; 

VAR  XREFFILE  :  TEXT); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  DETERMINES  THE  CROSS  REFERENCE  OPTION  DESIRED  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  XREFFILE  0  CROSS  REFERENCE  REPORT  FILE  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  DISPLAY  THE  CROSS  REFERENCE  MAIN  MENU.  *) 

(*  DETERMINE  WHICH  OPTION  WAS  CHOSEN  AND  CALL  THE  APPROPRIATE  *) 

(*  ROUTINE.  *) 

(*  LIST  ALL  ATTRIBUTES  OF  A  PARTICULAR  DATA  TYPE  (THIS  LIST  OF  *) 

(*  ATTRIBUTES  ALSO  INCLUDES  THE  ATTRIBUTES'  USER  ENTITY).  *) 

(*  LIST  ALL  ENTITIES  HAVING  AN  ATTRIBUTE  OF  A  PARTICULAR  *) 

(*  DEFINED  TYPE.  *) 

(*  LIST  ALL  ENTITIES  HAVING  AN  ATTRIBUTE  WITH  A  PARTICULAR  *) 

(*  NAME.  *) 

(*  LIST  ALL  CLASSES  CONTAINING  A  PARTICULAR  ENTITY.  *) 

(*  LIST  ALL  SUBSCHEMAS  CONTAINING  A  PARTICULAR  ENTITY.  *) 

(*  LIST  ALL  SUBSCEHMAS  CONTAINING  A  PARTICULAR  CLASS.  *) 

(*  LIST  ALL  EXISTING  PRECISIONS  FOR  THE  INTEGER  DATA  TYPE.  *) 

(*  LIST  ALL  EXISTING  PRECISIONS  FOR  THE  REAL  DATA  TYPE.  *) 

(*  LIST  ALL  EXISTING  LENGTHS  FOR  THE  STRING  DATA  TYPE.  *) 

(*  RETURN  TO  MAIN  MENU  *) 

(*  *) 

(*  $ COMMENTS:  *) 

(*  -  *> 
(*  $ CHANGE  CONTROL:  *) 
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(*  %INCLUDE  XMATTRES  *) 

(**) 

PROCEDURE  XMATTRES (VAR  MESS  :  MESSAGE; 

VAR  CLAS  :  T„ARRAYRV; 

VAR  ARRAY_SIZE  :  INTEGER; 

VAR  COM1  :  CHAR50; 

VAR  COM2  :  CHAR50; 

VAR  XREFFILE  :  TEXT; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  DISPLAYS  A  CROSS  REFERENCE  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  CLAS  I  THE  ARRAY  OF  MEMBERS  *) 

(*  ARRAY_SIZE  I  THE  SIZE  OF  THE  ARRAY  OF  MEMBERS  *) 

(*  COM1  I  THE  MENU  COMMENTS  *) 

(*  COM2  I  THE  MENU  COMMENTS  *) 

(*  XREFFILE  I/O  THE  CROSS  REFERENCE  REPORT  FILE  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  INITIALIZE  THE  VARIABLES  *) 

(*  PERMIT  THE  COMMUNICATION  BETWEEN  PANEL  "\RIABLES  AND  PROGRAM  *) 

(*  VARIABLES  -  *) 
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(*  CREATE  THE  TABLE  *) 
(*  PREPARE  TO  DISPLAY  THE  CROSS  REFERENCE  DISPLAY  MENU  *) 
(*  LOAD  THE  TABLE  AND  WRITE  THE  CROSS  REFERENCE  REPORT  RESULTS  TO  *) 
(*  FILE  *) 
(*  DISPLAY  THE  CROSS  REFERENCE  DISPLAY  MENU  *) 
(*  DETERMINE  THE  ACTION  SELECTED  FROM  THE  MENU  *) 
(*  REMOVE  CORRESPONDENCE  BETWEEN  PANEL  VARIABLES  AND  PROGRAM  *) 
(*  VARIABLES  .  *) 
(*  REMOVE  THE  TABLE  *) 
(*  *) 
(*  ^COMMENTS:  *) 
(*  NONE  *) 
(*  *) 
(*  $ CHANGE  CONTROL:  *) 

<*  *) 
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(*  %INCLUDE  XMMAIN  *) 

(**) 

PROCEDURE  XMMAIN (VAR  MESS 

VAR  NEXT_OP 
VAR  RR 


MESSAGE; 
OPERATIONS; 
RET_REC) ; 


(**) 

(*-- 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

<* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 


SUBPROGRAM; 


^FUNCTION: 

DISPLAYS  A  CROSS  REFERENCE  MENU 


^DESCRIPTION  OF  ARGUMENTS: 

NAME  I/O  DESCRIPTION 


MESS 

NEXTJDP 

RR 


I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 
0  ENUMERATED  TYPE  INDICATING  THE  NEXT 
OPERATION 

0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 
IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 


$ COMMONS : 

NONE 

^ENVIRONMENT : 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

DDNAMES  USED  WITH  STANDARD  FILES: 

NONE 


^EXECUTION  PROCEDURE: 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

^PROCESSING  DESCRIPTION: 

INITIALIZE  THE  VARIABLES 

PERMIT  THE  COMMUNICATION  BETWEEN  PANEL  VARIABLES  AND  PROGRAM 
VARIABLES 

DISPLAY  THE  CROSS  REFERENCE  MENU 
DETERMINE  THE  ACTION  SELECTED  FROM  THE  MENU 
REMOVE  CORRESPONDENCE  BETWEEN  PANEL  VARIABLES  AND  PROGRAM 
VARIABLES 

$ COMMENTS : 

NONE 

^CHANGE  CONTROL: 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*> 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  REVISED:  02/26/88  C.  H.  MOHME  DBMA  *) 

(*  MODIFIED  TO  INCORPORATE  ALLOCATE,  FREE,  BROWSE,  AND  PRINT  *) 

(*  CAPABILITIES.  *) 

(*  *) 

(*  ORIGINATED:  11/16/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - *) 

(*  •  *) 

(*END - *) 

(*  END  '/INCLUDE  XMMAIN  *) 
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(*  XINCLUDE  XMNAMSPE  *) 

(**) 

PROCEDURE  XMNAMSPE (VAR  MESS  :  MESSAGE; 

VAR  NAME  :  T_NAME; 

VAR  COM1  :  CHAR50; 

VAR  COM2  :  CHAR50; 

VAR  NEXT_0P  :  OPERATIONS; 

VAR  RR  :  RET_REC); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  DISPLAYS  A  CROSS  REFERENCE  REPORT  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NAME  I  THE  ENTITY  NAME  *) 

(*  COM!  I  THE  MENU  COMMENTS  *) 

(*  COM2  I  THE  MENU  COMMENTS  *) 

(*  NEXT.OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

<*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  INITIALIZE  THE  VARIABLES  *) 

(*  PERMIT  THE  COMMUNICATION  BETWEEN  PANEL  VARIABLES  AND  PROGRAM  *) 

(*  VARIABLES  *) 

(*  DISPLAY  THE  ENTITY  SPECIFICATION  MENU  *) 

(*  DETERMINE  THE  ACTION  SELECTED  FROM  THE  MENU  *) 

(*  REMOVE  CORRESPONDENCE  BETWEEN  PANEL  VARIABLES  AND  PROGRAM  *) 

(*  VARIABLES  .  *) 

(*  *) 
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(*  $ COMMENTS: 

(*  NONE 

(* 

(*  $ CHANGE  CONTROL: 

(* 

(*  REVISED:  MM/DD/YY  NAME 

(*  COMMENTS 

(* 

(*  REVISED:  MM/DD/YY  NAME 

(*  COMMENTS 

(* 

(*  REVISED:  MM/DD/YY  NAME 

(*  COMMENTS 

(* 

(*  ORIGINATED:  11/17/87  C.  H.  MOHME 

(* 

- - 

(* 

(*END - 

(*  END  %INCLUDE  XMNAMSPE  *) 


*) 

*> 

*) 

*) 

*) 

GROUP  *) 

*) 
*) 

GROUP  *) 

*> 
*) 

GROUP  *) 

*) 
*) 

DBMA  *) 

*) 

- *) 

*) 

- *) 
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(*  %INCLUDE  XMPRESPE  *) 

(**) 

PROCEDURE  XMPRESPE (VAR  MESS  :  MESSAGE; 

VAR  DATA_TYPE_KIND  :  INTEGER; 

VAR  SIZE  :  CKAR8; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC); 

SUBPROGRAM; 

<**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  DISPLAYS  A  CROSS  REFERENCE  REPORT  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  DATA_TYPE__KIND  I  THE  DATA  TYPE  KIND  *) 

(*  SIZE  0  THE  PRECISION  OF  THE  REAL  ENTERED  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

(*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  INITIALIZE  THE  VARIABLES  *) 

(*  PERMIT  THE  COMMUNICATION  BETWEEN  PANEL  VARIABLES  AND  PROGRAM  *) 

(*  VARIABLES  *) 

(*  DISPLAY  THE  CROSS  REFERENCE  MENU  *) 

(*  DETERMINE  THE  ACTION  SELECTED  FROM  THE  MENU  *) 

(*  REMOVE  CORRESPONDENCE  BETWEEN  PANEL  VARIABLES  AND  PROGRAM  *) 

(*  VARIABLES  *) 

(*  *) 
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(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 

(*  ORIGINATED:  11/19/87  C.  H.  MOHME  DBMA  *) 

(*  *) 

(* - ‘ - *) 

(*  *) 

(*END - *) 

(*  END  %INCLUDE  XMPRESPE*) 
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(*  ^INCLUDE  XMRESULT  *) 

(**) 

PROCEDURE  XMRESULT (VAR  MESS 

VAR  CLAS 
VAR  ARRAY_SIZE 
VAR  COM1 
VAR  COM2 
VAR  XREFFILE 
VAR  NEXT_OP 
VAR  RR 


MESSAGE; 

T_ARRAYTV ; 

INTEGER; 

CHAR50; 

CHAR50; 

TEXT; 

OPERATIONS; 
RET_REC) ; 


SUBPROGRAM; 

(**) 


(*- 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 


^FUNCTION: 

DISPLAYS  A  CROSS  REFERENCE  MENU 
^DESCRIPTION  OF  ARGUMENTS: 


NAME 

I/O 

DESCRIPTION 

MESS 

I 

THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL 

CLAS 

I 

THE  ARRAY  OF  MEMBERS 

ARRAY_SIZE 

I 

THE  SIZE  OF  THE  ARRAY  OF  MEMBERS 

COM1 

I 

MENU  COMMENTS 

COM2 

I 

MENU  COMMENTS 

XREFFILE 

I/O 

THE  CROSS  REFERENCE  REPORT  FILE 

NEXT_OP 

0 

ENUMERATED  TYPE  INDICATING  THE  NEXT 
OPERATION 

RR 

0 

INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND, 
IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN 

^COMMONS : 

NONE 

^ENVIRONMENT : 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

DDNAMES  USED  WITH  STANDARD  FILES: 

NONE 

^EXECUTION  PROCEDURE: 

SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE 

^PROCESSING  DESCRIPTION: 

INITIALIZE  THE  VARIABLES 

PERMIT  THE  COMMUNICATION  BETWEEN  PANEL  VARIABLES  AND  PROGRAM 
VARIABLES . 


■*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  CREATE  THE  TABLE  *) 

(*  PREPARE  TO  DISPLAY  THE  CROSS  REFERENCE  DISPLAY  MENU  *) 

(*  LOAD  THE  TABLE  AND  WRITE  THE  CROSS  REFERENCE  REPORT  RESULTS  *) 

(*  TO  FILE  *) 

(*  DISPLAY  THE  CROSS  REFERENCE  DISPLAY  MENU  *) 

(*  DETERMINE  THE  ACTION  SELECTED  FROM  THE  MENU  *) 

(*  REMOVE  CORRESPONDENCE  BETWEEN  PANEL  VARIABLES  AND  PROGRAM  *) 

(*  VARIABLES  *  *) 

(*  REMOVE  THE  TABLE  *) 

<*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  *) 
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(*  %INCLUDE  XMTYPSPE  *) 

(**) 

PROCEDURE  XMTYPSPE (VAR  MESS  :  MESSAGE; 

VAR  NEXT_OP  :  OPERATIONS; 

VAR  RR  :  RET_REC) ; 

SUBPROGRAM; 

(**) 

(* - - - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  DISPLAYS  A  CROSS  REFERENCE  MENU  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  MESS  I  THE  ERROR  MESSAGE  DISPLAYED  ON  THE  PANEL  *) 

(*  NEXT_OP  0  ENUMERATED  TYPE  INDICATING  THE  NEXT  *) 

(*  OPERATION  *) 

(*  RR  0  INDICATES  IF  AN  ERROR  HAS  OCCURRED  AND,  *) 

(*  IF  ONE  HAS,  WHAT  ROUTINE  IT  OCCURRED  IN  *) 

<*  *) 

(*  ^COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT :  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  DDNAMES  USED  WITH  STANDARD  FILES:  *) 

(*  NONE  *) 

(*  *) 

(*  $ EXECUTION  PROCEDURE:  *) 

(*  SCHEMA  EXECUTIVE  MENU  INTERFACE  ROUTINE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  INITIALIZE  THE  VARIABLES  *) 

(*  PERMIT  THE  COMMUNICATION  BETWEEN  PANEL  VARIABLES  AND  PROGRAM  *) 

(*  VARIABLES  *) 

(*  DISPLAY  THE  CROSS  REFERENCE  MENU  *) 

(*  DETERMINE  THE  ACTION  SELECTED  FROM  THE  MENU  *) 

(*  REMOVE  CORRESPONDENCE  BETWEEN  PANEL  VARIABLES  AND  PROGRAM  *) 

(*  VARIABLES  *) 

<*  *) 

(*  ^COMMENTS:  *) 

(*  NONE  *) 

(*  *) 

(*  $ CHANGE  CONTROL:  *) 

<*  '  *) 
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(*  %INCLUDE 
(**) 

PROCEDURE 


XNAMENUM  *) 

XNAMENUM(VAR  IRC 

VAR  CHAR_STRING 
VAR  BAD_NAME 
VAR  BAD_KIND_NUMBER 
VAR  NUMBER 


SUBPROGRAM; 

(**) 


RET_REC; 

X_NAME; 

BOOLEAN; 

BOOLEAN; 

INTEGER); 


(*• 

(* 

(* 

<* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

(* 

<* 

(* 

(* 

(* 

(* 


^FUNCTION: 

THIS  ROUTINE  DETERMINES  IF  A  CHARACTER  STRING  IS  A  NAME 
OR  NUMBER 

^DESCRIPTION  OF  ARGUMENTS: 

NAME  I/O  DESCRIPTION 

IRC 

CHAR_STRING 
BAD_NAME 

BAD_KIND_NUMBER 

NUMBER 


$ COMMONS : 

NONE 

^ENVIRONMENT: 

LANGUAGE:  IBM  PASCAL 

HARDWARE  SYSTEM:  IBM  360/370/4341/4381 

$ EXECUTION  PROCEDURE: 

INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE 
^PROCESSING  DESCRIPTION: 

DETERMINE  IF  THE  CHARACTER  STRING  (CHAR_STRING)  IS  A  VALID 
NAME  OR  KIND  NUMBER. 

^COMMENTS: 

^CHANGE  CONTROL: 


0  RETURN  CODE 
I  THE  GIVEN  CHARACTER  STRING 
0  INDICATES  IF  THE  GIVEN  CHARACTER  STRING 
IS  A  NAME 

0  INDICATES  IF  THE  GIVEN  CHARACTER  STRING 
IS  A  NUMBER 

0  THE  NUMBER  CONTAINED  IN  THE  CHARACTER 
STRING 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 
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(*  %INCLUDE  XRESULT  *) 

(**) 

PROCEDURE  XRESULT(VAR  IRC  :  RET_REC ; 

VAR  RESULT_LIST  :  LISTKEY; 

VAR  COM1  :  CHAR50; 

VAR  COM2  :  CHARS 0; 

VAR  XREFFILE  :  TEXT; 

VAR  OPTION  :  OPERATIONS); 

SUBPROGRAM; 

(**) 

(* - *) 

(*  *) 

(*  $ FUNCTION:  *) 

(*  THIS  ROUTINE  DISPLAYS  THE  CROSS  REFERENCE  REPORT  RESULTS  *) 

(*  *) 

(*  ^DESCRIPTION  OF  ARGUMENTS:  *) 

(*  NAME  I/O  DESCRIPTION  *) 

(*  IRC  0  RETURN  CODE  *) 

(*  RESULT_LIST  I  THE  CROSS  REFERENCE  RESULT  LIST  *) 

(*  COM1  I  MENU  COMMENTS  DESCRIBING  THE  OUTPUT  *) 

(*  COM2  I  MENU  COMMENTS  DESCRIBING  THE  OUTPUT  *) 

(*  XREFFILE  I/O  CROSS  REFERENCE  REPORT  FILE  *) 

(*  OPTION  0  OPTION  SELECTED  *) 

(*  *) 

(*  $ COMMONS:  *) 

(*  NONE  *) 

(*  *) 

(*  ^ENVIRONMENT:  *) 

(*  LANGUAGE:  IBM  PASCAL  *) 

(*  HARDWARE  SYSTEM:  IBM  360/370/4341/4381  *) 

(*  *) 

(*  ^EXECUTION  PROCEDURE:  *) 

(*  INTERNAL  PROCEDURE  FOR  THE  SCHEMA  EXECUTIVE  *) 

(*  *) 

(*  ^PROCESSING  DESCRIPTION:  *) 

(*  READ  EACH  KEY  OFF  OF  THE  RESULT  LIST.  *) 

(*  FROM  EACH  ENTITY  ADB  OBTAIN  THE  ENTITY  NAME  (AND  KIND  NUMBER,  *) 

(*  IF  APPLICABLE).  *) 

(*  FILL  UP  THE  TABLE  OF  NAMES  AND  KIND  NUMBERS  FOR  DISPLAY  ON  *) 

(*  THE  CROSS  REFERENCE  MENU.  *) 

(*  DISPLAY  THE  CROSS  REFERENCE  REPORT  RESULTS  MENU.  *) 

(*  *) 

(*  $ COMMENTS:  *) 

<*  *) 

(*  $ CHANGE  CONTROL:  *) 

(*  -  *) 


